Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/smaltalk/manchest.lha/MANCHESTER/manchester/4.1/interactors/Interactors-Framework.st

Text File | 1993-07-24 | 119KB | 4,505 lines

Controller subclass: #InteractorController
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!InteractorController methodsFor: 'control defaults'!

controlActivity

    sensor redButtonPressed ifTrue: [^view selectDown: sensor mousePoint].
    sensor yellowButtonPressed ifTrue: [^view operateDown: sensor mousePoint].
    sensor keyboardPressed ifTrue: [^view keyboardDown: sensor mousePoint].
    ^view startUp: sensor mousePoint.    "Pseudo event, caught by controllers."! !

Object subclass: #Interactor
    instanceVariableNames: 'clientData window selected extent sensor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!
Interactor comment:
'perspective            (Perspective) the perspective on which I am a representation
dialogManager        (DialogManager) the dialog manager to which I am responsible
operators            (Set of ?) the set of operators that I am willing to respond to
selected            (Boolean) true if I am the destination for operations
topRepresentation    (Representation) the root of the representation hierarchy of which I am part
extent                (Point) my extent (including any decorations)
bordered            (Boolean) true if I have a border around me
identifier            (String/Symbol) the name with which I label myself during debugging
window            (WindowRepresentation/ScheduledWindow?) the window on which I render myself'!


!Interactor methodsFor: 'initialize-release'!

initialize
    selected := false!

release

    window := sensor := nil.
    super release.! !

!Interactor methodsFor: 'hierarchy'!

installComposites!

installHierarchy!

installSensor: aSensor

    self sensor: aSensor!

installWindow: aWindow

    self window: aWindow!

rootInteractor
    ^self parent rootInteractor! !

!Interactor methodsFor: 'geometry'!

computeBounds: bounds
    ^self subclassResponsibility!

computeExtent
    ^self subclassResponsibility!

computeMinimumExtent
    ^self computeExtent! !

!Interactor methodsFor: 'accessing'!

clientData
    ^clientData!

clientData: aDatum
    clientData := aDatum!

defaultExtent: ext
    extent isNil ifTrue: [self extent: ext]!

extent
    extent isNil ifTrue: [self extent: self minimumExtent].
    ^extent copy!

extent: aPoint
    extent := aPoint!

height
    ^extent y!

height: h
    ^extent y: h!

lookPreferences
    ^self rootInteractor lookPreferences!

parent: p
    "Catch any illicit attempts to install parents in interactors that have non (such
    as the rootInteractor)"

    ^self shouldNotImplement!

selected
    ^selected "isNil ifTrue: [selected := false] ifFalse: [selected]"!

selected: s
    selected := s!

sensor
    ^sensor!

sensor: s
    sensor := s.
    self window: s window!

transparentSelf!

width
    ^extent x!

width: w
    ^extent x: w!

window
    ^window!

window: win
    window := win! !

!Interactor methodsFor: 'rendering'!

damaged

    "An interactor that doesn't know how to handle damage should defer to its parent"

    ^self parent damaged!

graphicsContext
    "An interactor that doesn't know about its graphics context should ask its parent for one."

    ^self parent graphicsContextFor: self!

graphicsContextFor: anInteractor
    "An interactor that doesn't know about its graphics context should ask its parent for one."

    ^self parent graphicsContextFor: anInteractor!

render
    ^self renderOn: self graphicsContext!

renderBackgroundOn: aGC

    aGC displayRectangle: self bounds!

renderDeselectedOn: aGC

    self
        renderForeground: self foregroundColor
        background: self backgroundColor
        on: aGC!

renderForeground: foregroundColor background: backgroundColor on: aGC

    aGC paint: backgroundColor.
    self renderBackgroundOn: aGC.
    aGC paint: foregroundColor.
    self renderForegroundOn: aGC!

renderForegroundOn: aGC!

renderGreyedOn: aGC

    self
        renderForeground: self greyedForegroundColor
        background: self greyedBackgroundColor
        on: aGC!

renderOn: aGC
    (aGC clippingBounds intersects: self bounds)
        ifTrue:
            [self selected isNil
                ifTrue:
                    [self renderGreyedOn: aGC]
                ifFalse:
                    [self selected
                        ifTrue: [self renderSelectedOn: aGC]
                        ifFalse: [self renderDeselectedOn: aGC]]]!

renderSelectedOn: aGC

    self
        renderForeground: self selectionForegroundColor
        background: self selectionBackgroundColor
        on: aGC! !

!Interactor methodsFor: 'conversions'!

active
    ^ActiveInteractor on: self!

bordered
    ^BorderInteractor on: self!

bordered: n
    ^self bordered borderWidth: n!

cachedScrolling
    ^CachedScrollingInteractor on: self!

inset
    ^InsetInteractor on: self!

inset: n
    ^InsetInteractor inset: n on: self!

scrolling
    ^ScrollingInteractor on: self! !

!Interactor methodsFor: 'visual properties'!

backgroundColor
    ^self lookPreferences backgroundColor!

borderBackgroundColor

    ^ColorValue white!

borderBounds

    ^self origin corner: self corner - self cornerCorrection!

borderForegroundColor

    ^ColorValue black!

compositionBounds
    | bb |
    ^(bb := self borderBounds) origin + self borderWidth corner: bb corner!

cornerCorrection

    "Because the graphics system defines the bottom-right pixel of
    an object to be one pixel in from the corner, we have to adjust
    for the fact in certain conditions.  If this problem ever gets fixed,
    this method will have to return 0@0 (no correction)."

    ^1@1!

foregroundColor
    ^self lookPreferences foregroundColor!

greyedBackgroundColor
    ^ColorValue brightness: 0.6!

greyedForegroundColor
    ^ColorValue brightness: 0.8!

selectionBackgroundColor
    ^self lookPreferences selectionBackgroundColor!

selectionForegroundColor
    ^self lookPreferences selectionForegroundColor!

windowLabel: l
    ^self rootInteractor windowLabel: l! !

!Interactor methodsFor: 'scheduling'!

close
    self window isNil ifFalse: [self window controller close]!

open
    ^(RootInteractor on: self) open! !

!Interactor methodsFor: 'event enquiry'!

containsPoint: aPoint
    ^self bounds containsPoint: aPoint!

interactorAt: aPoint
    "There's no point in checking further, it *MUST* be me!!!!!!"

    ^(self bounds containsPoint: aPoint) ifTrue: [self]! !

!Interactor methodsFor: 'event response'!

keyboardDown
    "Throw away keyboard events that aren't intercepted lower down"

    [self sensor keyboardPressed]     whileTrue: [self sensor keyboardEvent]!

operateDown

    self inspect!

selectDown!

selectDownDown
    ^self selectDown!

startUp

    "Author: IKP, 1992-08-22.   (This is all getting rather complicated.)"

    "This is a pseudo-event sent priodically for the benefit of Interactors
    that encapsulate Smalltalk View-Controller pairs.  Legitimate Interactors
    should ignore this event, since it does not signify any kind of I/O activity.
    MVC-wrapping interactors should respond to this event by implementing
    a control dispatch loop for the benefit of the underlying controller."! !

!Interactor methodsFor: 'default accessing'!

componentDeselected!

componentSelected!

isAlignedComposite
    ^false!

isComposite
    ^false!

isDynamicComposite
    ^false!

radioGroup: aGrouper

    "Anything that doesn't override this basically doesn't care"! !

!Interactor methodsFor: 'error handling'!

uimsError
    ^self error: 'degenerate case in UIMS geometry management - HELP!!!!!!'! !

!Interactor methodsFor: 'printing'!

auxiliaryPrintInfo
    ^' (' , self minimumExtent printString , ' -> ' , self extent printString , ')'!

hierarchy

    | aStream |
    aStream := WriteStream on: (String new: 256).
    self printHierarchyOn: aStream indent: 0.
    ^aStream contents!

printHierarchyOn: aStream!

printHierarchyOn: aStream indent: i
    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo!

printOn: aStream
    super printOn: aStream.
    aStream nextPutAll: ' (' , self minimumExtent printString , ' -> ' , self extent printString , ')'! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Interactor class
    instanceVariableNames: ''!


!Interactor class methodsFor: 'instance creation'!

minimumExtent: e
    ^self new minimumExtent: e!

new
    ^super new initialize! !

!Interactor class methodsFor: 'examples'!

activeExample

    (TextInteractor new addChild: 'push me!!') active open!

allocationExample

    | thing |
    thing := AlignedColumnInteractor new.
    1 to: 5 do: [ :allocation | thing
        addChild: ((TextInteractor new addChild: allocation printString) inset) bordered
        allocation: allocation].
    thing open!

allocationExample2

    | thing |
    thing := AlignedRowInteractor new.
    1 to: 5 do: [ :allocation | thing
        addChild: ((TextInteractor new addChild: allocation printString) inset) bordered
        allocation: allocation].
    ^thing open!

borderExample

    (ColumnInteractor new
        addChild: ((TextInteractor new
                    addChild: 'aButton') bordered roundBorders borderWidth: 1) active inset;
        addChild: ((TextInteractor new
                    addChild: 'aButton') bordered roundBorders borderWidth: 1) active inset;
        addChild: ((TextInteractor new
                    addChild: 'aButton') bordered roundBorders borderWidth: 1) active inset;
        addChild: ((TextInteractor new
                    addChild: 'aButton') bordered roundBorders borderWidth: 1) active inset)
    minimumExtent: 130@150; open!

buttonExample

    ((((TextInteractor new
        minimumExtent: 200@50;
        addChild: 'aButton') bordered: 1) inverseBorders) bordered: 3) active
    open!

columnExample

    (ColumnInteractor new
        addChild: (((TextInteractor new addChild: 'button A') inset: 3) bordered active);
        addChild: (((TextInteractor new addChild: 'button label B'; vRigid: true) inset: 3) bordered active);
        addChild: (((TextInteractor new addChild: 'buttonC'; rigid: true) inset: 3) bordered active))
    open!

columnExample2

    (ColumnInteractor new
        addChild: (TextInteractor new addChild: 'button A'; vRigid: false) bordered active;
        addChild: (TextInteractor new addChild: 'button B'; vRigid: false) bordered active;
        addChild: (TextInteractor new addChild: 'button C'; vRigid: false) bordered active)
    open!

complexExample
    self complexInteractor open!

composedTextExample

    (StructuredTextInteractor new
        addChild: self exampleString;
        minimumExtent: 200@50;
        inset) open.
    ^(StructuredTextInteractor new
        addChild: self exampleString;
        selected: true;
        inset) open!

convertorExample

    ((TextInteractor addChild: 'hello world!!')
            textConvertor: [ :string | 'Well, ' , string])
        inset inset inset bordered active open!

cyclicButtonExample

    | virtual |
    virtual := (VirtualInteractor new
        addChild: ((TextInteractor new addChild: 'one') inset inset inset bordered active onBlock: [ :x | virtual useComponentNext]);
        addChild: ((TextInteractor new addChild: 'two') inset inset inset bordered active onBlock: [ :x | virtual useComponentNext]);
        addChild: ((TextInteractor new addChild: 'three') inset inset inset bordered active onBlock: [ :x | virtual useComponentNext]);
        addChild: ((TextInteractor new addChild: 'four') inset inset inset bordered active onBlock: [ :x | virtual useComponentNext])).

    virtual activeChild: virtual children first.
    ^virtual open!

emptyExample

    (ColumnInteractor new
        addChild: (TextInteractor new addChild: 'hello');
        addChild: RowInteractor new bordered;
        addChild: (TextInteractor new addChild: 'world'))
    open!

extensibleExample

    "Build a composite interactor with extensible functionality.  Most of the complexity in what follows is to do with disabling the
    add/remove buttons when the extending composite is full/empty."

    | labelButtonRow addButton addBlock removeButton removeBlock extender interface dummy buttonCount countBlock |
    buttonCount := 0.
    extender := RowInteractor new extent: 200@50.
    dummy := [ :ignore ].
    addButton := ((TextInteractor on: 'add') minimumExtent: 100@20) active.
    removeButton := ((TextInteractor on: 'remove') minimumExtent: 100@20) active.
    addBlock := [ :sender |
        countBlock value: 1.
        extender installChild: (BorderInteractor on: ((TextInteractor on: 'button') active onBlock: dummy))].
    removeBlock := [ :sender |
        countBlock value: -1.
        extender uninstallLastChild].
    countBlock := [ :step |
        buttonCount := buttonCount + step.
        addButton onBlock: (buttonCount < 6 ifTrue: [addBlock]).
        removeButton onBlock: (buttonCount > 0 ifTrue: [removeBlock])].

    labelButtonRow := RowInteractor new
        addChild: (InsetInteractor inset: 5 on: (TextInteractor on: 'extensible interactors...'));
        addChild: (InsetInteractor inset: 5 on: (BorderInteractor on: addButton));
        addChild: (InsetInteractor inset: 5 on: (BorderInteractor on: removeButton)).

    countBlock value: 0.

    interface := ColumnInteractor new
        addChild: labelButtonRow;
        addChild: extender.
    interface open!

fillerExample

    ^(RowInteractor new
        addChild: (TextInteractor new addChild: '<<<'; hRigid: true);
        addChild: (self fillerInteractor minimumExtent: 20@0);
        addChild: (TextInteractor new addChild: '>>>'; hRigid: true))
    open!

fillerExample2

    ^(ColumnInteractor new
        addChild: (TextInteractor new addChild: '^^^'; hRigid: true) bordered;
        addChild: (FillerInteractor new minimumExtent: 20@20);
        addChild: (TextInteractor new addChild: 'vvv'; hRigid: true) bordered)
    open!

greyExample

    | button1 button2 |
    button1 := (TextInteractor new
        addChild: 'greyable';
        minimumExtent: 200@50)
        inset bordered active selected: nil.
    button2 := (TextInteractor new
        addChild: 'grey it!!';
        minimumExtent: 200@50)
        inset bordered active onBlock: [ :i | button1 selected: nil; render].
    ColumnInteractor new
        addChild: button1;
        addChild: button2;
        open!

imageExample

    ^(ColumnInteractor new
        addChild: ((TextInteractor on: 'press me') inset: 5);
        addChild: (ImageInteractor new addChild: self exampleImage)
                    bordered active inset)
    open!

inputFieldExample

    | label accept |
    label := (TextInteractor on: 'input displayed here') vRigid: true.
    accept := [ :sender :value | label addChild: value; render].
    ColumnInteractor new
        addChild: (BorderInteractor on: (InputFieldInteractor new acceptBlock: accept));
        addChild: (BorderInteractor on: label);
        open!

insetExample

    (((TextInteractor new extent: 200@50; addChild: 'aButton') inset: 10) bordered: 3) active
        open!

labelExample

    (TextInteractor new addChild: 'hello'; minimumExtent: 200@50) bordered open!

mvcExample2

    | image view imageLayout viewLayout wrappedImage wrappedView composite window |

    image := Image parcPlaceLogo.

    imageLayout := LayoutFrame new
        leftFraction: 1.0;
        leftOffset: image width negated.

    wrappedImage := BoundedWrapper
        on: image
        in: imageLayout.

    composite := CompositePart new.
    composite addWrapper: wrappedImage.

    view := TextView
        on: LauncherView comment asComposedText
        aspect: #text
        change: #text:
        menu: nil.

    viewLayout := LayoutFrame new
        rightFraction: 1.0;
        rightOffset: image width negated;
        bottomFraction: 1.0.

    wrappedView := BorderedWrapper
        on: view
        in: viewLayout.

    composite addWrapper: wrappedView.

    window := MessageLogger on: (ScheduledWindow new).
    window component: (view).
    window minimumSize: 500@300.
    window open!

nestedRadioExample

    ^((RowInteractor new)
        addChild: (ColumnInteractor new
            addChild: ((TextInteractor on: 'one') inset bordered active toggle);
            addChild: ((TextInteractor on: 'two') inset bordered active toggle));
        addChild: (ColumnInteractor new
            addChild: ((TextInteractor on: 'three') inset bordered active toggle);
            addChild: ((TextInteractor on: 'four') inset bordered active toggle));
        beRadioGroup)
    open!

nestedScrollingExample

    ^(RowInteractor new
        addChild: (self complexInteractor4 cachedScrolling
            minimumExtent: 200@200;
            useBothScrollers);
        addChild: ((TextInteractor new minimumExtent: 400@400; addChild: 'Right') cachedScrolling
            minimumExtent: 200@200;
            useBothScrollers)) cachedScrolling useBothScrollers open!

nestedScrollingExample2

    "This is utterly ludicrous, but should demonstrate that scrollers are at last working..!!"

    ((((((((((((TextInteractor addChild: 'Find Me!!') justification: #center)
        inset bordered active inset: 100) rigid
        bordered inverseBorders inset bordered cachedScrolling useBothScrollers minimumExtent: 600@600)
        bordered cachedScrolling useBothScrollers minimumExtent: 550@550)
        bordered cachedScrolling useBothScrollers minimumExtent: 500@500)
        bordered cachedScrolling useBothScrollers minimumExtent: 450@450)
        bordered cachedScrolling useBothScrollers minimumExtent: 400@400)
        bordered cachedScrolling useBothScrollers minimumExtent: 350@350)
        bordered cachedScrolling useBothScrollers minimumExtent: 300@300)
        bordered cachedScrolling useBothScrollers minimumExtent: 250@250)
        bordered cachedScrolling useBothScrollers minimumExtent: 200@200)
        open!

objectExample

    ^(ObjectInteractor new addChild: 42; justification: #center; displayConvertor: [ :x | (x * 2) printString]) bordered
        active open!

penPadButtonExample
    "An example for pcj showing how to create Pen&Pad v5 style buttons"

    | top onBlock offBlock |
    top := ColumnInteractor new.
    5 timesRepeat:
        [ | virtual |
        virtual := (VirtualInteractor new
            addChild: ((TextInteractor new addChild: 'one') inset inset inset bordered);
            addChild: ((TextInteractor new addChild: 'two') inset inset inset bordered);
            addChild: ((TextInteractor new addChild: 'three') inset inset inset bordered);
            addChild: ((TextInteractor new addChild: 'four') inset inset inset bordered)).

        virtual activeChild: virtual children first.
        onBlock := [ :button | virtual useComponentNext == virtual children first ifTrue: [button deselect]].
        offBlock := [ :button | virtual useComponentIndex: 1].
        top addChild: (virtual active cyclic onBlock: onBlock; offBlock: offBlock)].

    top beRadioGroup open!

radioExample
    | top one two |
    top := ColumnInteractor new.
    top
        addChild: (one := (TextInteractor on: 'one') inset bordered active toggle);
        addChild: (two := (TextInteractor on: 'two') inset bordered active toggle).
    one
        onBlock: [ :i | Transcript cr; show: 'one on'];
        offBlock: [ :i | Transcript cr; show: 'one off'].
    two
        onBlock: [ :i | "self halt." Transcript cr; show: 'two on'];
        offBlock: [ :i | Transcript cr; show: 'two off'].
    top beRadioGroup; open!

reallocationExample

    | one two |
    one := ((ColumnInteractor new)
        addChild: (AlignedRowInteractor new
            addChild: ((TextInteractor on: 'short') bordered active toggle);
            addChild: ((TextInteractor on: 'far longer than the previous utterly tiny field (by comparison)') bordered active toggle));
        addChild: (AlignedRowInteractor new
            addChild: ((TextInteractor on: 'weeny') bordered active toggle);
            addChild: ((TextInteractor on: 'tiny') bordered active toggle));
        beRadioGroup).

    two := ((DynamicColumnInteractor new)
        addChild: (AlignedRowInteractor new
            addChild: ((TextInteractor on: 'short') bordered active toggle);
            addChild: ((TextInteractor on: 'far longer than the previous utterly tiny field (by comparison)') bordered active toggle));
        addChild: (AlignedRowInteractor new
            addChild: ((TextInteractor on: 'weeny') bordered active toggle);
            addChild: ((TextInteractor on: 'tiny') bordered active toggle));
        beRadioGroup).

    one open.
    two open!

reallocationExample2


    (DynamicColumnInteractor new
        addChild: (AlignedRowInteractor new
            addChild: ((TextInteractor on: 'short') bordered active toggle);
            addChild: ((TextInteractor on: 'a bit longer') bordered active toggle));
        addChild: (TextInteractor on: 'boom!!') inset bordered;
        addChild: (AlignedRowInteractor new
            addChild: ((TextInteractor on: 'longish') bordered active toggle);
            addChild: ((TextInteractor on: 'teeny') bordered active toggle)))
    open!

reallocationExample3
    "This is DESIGNED to break!!!!!!"


    (DynamicColumnInteractor new
        addChild: (AlignedRowInteractor new
            addChild: (AlignedRowInteractor new
                addChild: ((TextInteractor on: 'short') bordered active toggle);
                addChild: ((TextInteractor on: 'a bit longer') bordered active toggle));
            addChild: (TextInteractor on: 'boom!!') bordered;
            addChild: (AlignedRowInteractor new
                addChild: ((TextInteractor on: 'longish') bordered active toggle);
                addChild: ((TextInteractor on: 'teeny') bordered active toggle)));
        addChild: (AlignedRowInteractor new
            addChild: (AlignedRowInteractor new
                addChild: ((TextInteractor on: 'short') bordered active toggle);
                addChild: ((TextInteractor on: 'a bit longer') bordered active toggle));
            addChild: (TextInteractor on: 'boom!!') bordered;
            addChild: (AlignedRowInteractor new
                addChild: ((TextInteractor on: 'longish') bordered active toggle);
                addChild: ((TextInteractor on: 'teeny') bordered active toggle))))
    open!

rowExample

    (RowInteractor new
        addChild: (TextInteractor new addChild: 'button 1') bordered active;
        addChild: (TextInteractor new addChild: 'button 2'; hRigid: true) bordered active;
        addChild: (TextInteractor new addChild: 'button 3'; hRigid: true) bordered active)
    open!

scrollingExample

    ((TextInteractor new addChild: 'scroll me!!'; minimumExtent: 400@400; yourself) cachedScrolling
        minimumExtent: 50@50;
        useBothScrollers) bordered open!

scrollingExample2

    RowInteractor new
        addChild: ((ColumnInteractor new
            addChild: ((TextInteractor minimumExtent: 100@100) rigid: true; addChild: 'Above') bordered active;
            addChild: ((TextInteractor minimumExtent: 100@100) rigid: true; addChild: 'Below') bordered active)
                            cachedScrolling useBothScrollers minimumExtent: 50@50);
        addChild: (((TextInteractor minimumExtent: 100@100) rigid: false; addChild: 'Right')
                            bordered active cachedScrolling useBothScrollers minimumExtent: 50@50);
        open!

scrollingExample3

     (RowInteractor new
        addChild: (self complexInteractor4 cachedScrolling
            minimumExtent: 50@50;
            useBothScrollers);
        addChild: ((TextInteractor new minimumExtent: 400@400; addChild: 'Right') cachedScrolling
            minimumExtent: 50@50;
            useBothScrollers)) open!

scrollingStructuredTextExample

    (StructuredTextInteractor new
        addChild: (NLP penPadPrint: TestEntity);
        selectionEmphasis: #(italic underline bold);
        selectionBlock: [ :int :bog | Transcript cr; show: bog subject printString];
        minimumExtent: 200@50;
        inset) cachedScrolling useBothScrollers open!

simpleScrollingExample

    ((TextInteractor new addChild: 'scroll me!!'; minimumExtent: 400@400; yourself) scrolling
        minimumExtent: 50@50;
        useBothScrollers) bordered open!

simpleScrollingExample2

    RowInteractor new
        addChild: ((ColumnInteractor new
            addChild: ((TextInteractor minimumExtent: 100@100) rigid: true; addChild: 'Above') bordered active;
            addChild: ((TextInteractor minimumExtent: 100@100) rigid: true; addChild: 'Below') bordered active)
                            scrolling useBothScrollers minimumExtent: 50@50);
        addChild: (((TextInteractor minimumExtent: 100@100) rigid: false; addChild: 'Right')
                            bordered active scrolling useBothScrollers minimumExtent: 50@50);
        open!

simpleScrollingExample3

     (RowInteractor new
        addChild: (self complexInteractor4 scrolling
            minimumExtent: 50@50;
            useBothScrollers);
        addChild: ((TextInteractor new minimumExtent: 400@400; addChild: 'Right') scrolling
            minimumExtent: 50@50;
            useBothScrollers)) open!

simpleScrollingStructuredTextExample

    (StructuredTextInteractor new
        addChild: (NLP penPadPrint: TestEntity);
        selectionEmphasis: #(italic underline bold);
        selectionBlock: [ :int :bog | Transcript cr; show: bog subject printString];
        minimumExtent: 200@50;
        inset:60) scrolling useBothScrollers open!

sliderBoundedExample

    (SliderInteractor new
        minVal: 50;
        maxVal: 500;
        valueBlock: [ :i :x | Transcript cr; show: x printString]; currentValue: 50) open.!

sliderExample

    (SliderInteractor new valueBlock: [ :i :x | Transcript cr; show: x printString]; currentValue: 50) open.!

sliderExample2
    | slider up down |
    slider := SliderInteractor new
        incrementSize: 5;
        valueBlock: [ :i :x | Transcript cr; show: x printString].
    up := (TextInteractor addChild: '+') inset bordered active autoRepeat onBlock: [ :x | slider increment].
    down := (TextInteractor addChild: '-') inset bordered active autoRepeat onBlock: [ :x | slider decrement].
    ^(RowInteractor new
        addChild: (ColumnInteractor new
            addChild: up;
            addChild: down);
        addChild: slider)
    open!

sliderExample3
    | slider up down cancel |
    slider := SliderInteractor new
        incrementSize: 5;
        valueBlock: [ :i :x | Transcript cr; show: x printString].
    up := (TextInteractor addChild: '+') inset bordered active autoRepeat onBlock: [ :x | slider increment].
    down := (TextInteractor addChild: '-') inset bordered active autoRepeat onBlock: [ :x | slider decrement].
    cancel := (TextInteractor addChild: 'clear') inset bordered active autoRepeat onBlock: [ :x | slider clearValue].
    ^(RowInteractor new
        addChild: (ColumnInteractor new
            addChild: (RowInteractor new
                addChild: down;
                addChild: up);
            addChild: cancel);
        addChild: slider)
    open!

sliderExample4
    | slider up down cancel typer |
    slider := SliderInteractor new
        incrementSize: 5;
        valueBlock: [ :i :x | Transcript cr; show: x printString].
    up := (TextInteractor addChild: '+') inset bordered active autoRepeat onBlock: [ :x | slider increment].
    down := (TextInteractor addChild: '-') inset bordered active autoRepeat onBlock: [ :x | slider decrement].
    cancel := (TextInteractor addChild: 'clear') inset bordered active autoRepeat onBlock: [ :x | slider clearValue].
    typer := InputFieldInteractor new.
    typer acceptBlock: [ :i :x | slider newValue: (Integer readFrom: (ReadStream on: x))].
    ^(RowInteractor new
        addChild: (ColumnInteractor new
            addChild: (RowInteractor new
                addChild: down;
                addChild: up);
            addChild: cancel);
        addChild: slider;
        addChild: typer inset bordered)
    open!

sliderExample5

    (ColumnInteractor new
        addChild: (SliderInteractor new valueBlock: [ :i :x | Transcript cr; show: x printString]; currentValue: 50);
        addChild: (SliderInteractor new valueBlock: [ :i :x | Transcript cr; show: x printString]; currentValue: 50);
        addChild: (FillerInteractor minimumExtent: 50@50))
     open.!

sliderExample6
    | slider |
    (RowInteractor new
        addChild: (slider := SliderInteractor new
                    valueBlock: [ :i :x | Transcript cr; show: x printString]; currentValue: 50);
        addChild: (InputFieldInteractor new
                    acceptBlock: [ :i :s |
                        slider newValue: (Number readFrom: s readStream).
                        i setText: ''; render];
                    minimumExtent: 50@0)) open.!

sliderFixedPointExample

    (FixedPointSliderInteractor new valueBlock: [ :i :x | Transcript cr; show: x printString]; currentValue: 50) open.!

sliderFixedPointExample2

    (FixedPointSliderInteractor new
        scaling: 100;
        valueBlock: [ :i :x | Transcript cr; show: x printString]; currentValue: 50) open.!

structuredTextExample

    (StructuredTextInteractor new
        addChild: (NLP penPadPrint: TestEntity);
        selectionEmphasis: #(italic underline bold);
        selectionBlock: [ :int :bog | Transcript cr; show: bog subject printString];
        minimumExtent: 200@50;
        inset) open!

textExample

    TextInteractor new
        addChild: 'not selected';
        minimumExtent: 200@50;
        justification: #center;
        open.
    ^TextInteractor new
        addChild: 'selected';
        selected: true;
        open!

toggleExample

    ^((TextInteractor on: 'toggle') inset bordered active toggle
        onBlock: [ :x | Transcript tab; show: 'ON!!'];
        offBlock: [ :x | Transcript tab; show: 'off!!!!!!'])
    open!

virtualExample

    "Build a virtual interactor with obviously varying functionality"

    | label virtual top |

    label := TextInteractor new addChild: 'virtual interactions'; justification: #center; textStyle: (TextAttributes styleNamed: #large).

    (virtual := VirtualInteractor new
        addChild: (TextInteractor new addChild: 'Inactive Text Pane');
        addChild: (ColumnInteractor new
            addChild: (TextInteractor new addChild: 'Active...');
            addChild: (RowInteractor new
                addChild: (TextInteractor new addChild: '1'; justification: #right) inset bordered active;
                addChild: (TextInteractor new addChild: '2'; justification: #center) inset bordered active;
                addChild: (TextInteractor new addChild: '3'; justification: #left) inset bordered active);
            addChild: (TextInteractor new addChild: '...buttons'));
        addChild: (RowInteractor new
            addChild: (TextInteractor new addChild: 'More...');
            addChild: (RowInteractor new
                addChild: (TextInteractor new addChild: 'A') inset bordered active;
                addChild: (TextInteractor new addChild: 'B') inset bordered active;
                addChild: (TextInteractor new addChild: 'C') inset bordered active);
            addChild: (TextInteractor new addChild: '...buttons!!'))).

    (top := ColumnInteractor new)
        addChild: label;
        addChild: (RowInteractor new
            addChild: virtual bordered inverseBorders;
            addChild: (ColumnInteractor new
                addChild: ((TextInteractor new addChild: 'one'; rigid: false) inset bordered recessedBorders active toggle onBlock:
                            [ :me | virtual useComponentIndex: 1; windowLabel: 'Simple Text']);
                addChild: ((TextInteractor new addChild: 'two'; rigid: false) inset bordered recessedBorders active toggle onBlock:
                            [ :me | virtual useComponentIndex: 2; windowLabel: 'Horizontal Buttons']);
                addChild: ((TextInteractor new addChild: 'three'; rigid: false) inset bordered recessedBorders active toggle onBlock:
                            [ :me | virtual useComponentIndex: 3; windowLabel: 'Vertical Buttons']);
                beRadioGroup)).

    virtual activeChild: nil.

    top open windowLabel: 'No Component'!

wrappedTextExample

    WrappedTextInteractor new
        addChild: self exampleString;
        minimumExtent: 100@50;
        open!

xServerThrashingExample

    | top |
    top := RowInteractor new.
    17 timesRepeat:
        [ | bottom |
        bottom := ColumnInteractor new.
        8 timesRepeat: [bottom addChild:
                        ((TextInteractor on: 'hello') minimumExtent: 500@300) cachedScrolling useBothScrollers bordered].
        top addChild: bottom].
    top cachedScrolling useBothScrollers open! !

!Interactor class methodsFor: 'examples-private'!

complexInteractor
    ^ColumnInteractor new
        addChild: (RowInteractor new
            addChild: (TextInteractor new addChild: '1'; hRigid: false; vRigid: false) inset bordered active;
            addChild: (TextInteractor new addChild: '2'; hRigid: true; vRigid: false) inset bordered;
            addChild: (TextInteractor new addChild: '3'; hRigid: false; vRigid: false) inset bordered);
        addChild: (RowInteractor new
            addChild: (TextInteractor new addChild: '4'; hRigid: false; vRigid: true) inset bordered;
            addChild: (TextInteractor new addChild: '5'; hRigid: true; vRigid: true) inset bordered;
            addChild: (TextInteractor new addChild: '6'; hRigid: false; vRigid: true) inset bordered);
    addChild: (RowInteractor new
        addChild: (TextInteractor new addChild: '7'; hRigid: false; vRigid: false) inset bordered;
        addChild: (TextInteractor new addChild: '8'; hRigid: true; vRigid: false) inset bordered;
        addChild: (TextInteractor new addChild: '9'; hRigid: false; vRigid: false) inset bordered)!

complexInteractor2

    ^RowInteractor new
        addChild: (ColumnInteractor new
            addChild: (TextInteractor new addChild: '1'; hRigid: true; vRigid: true) inset bordered active;
            addChild: (TextInteractor new addChild: '2'; hRigid: true; vRigid: false) inset bordered;
            addChild: (TextInteractor new addChild: '3'; hRigid: true; vRigid: true) inset bordered);
        addChild: (ColumnInteractor new
            addChild: (TextInteractor new addChild: '4'; hRigid: false; vRigid: true) inset bordered;
            addChild: (TextInteractor new addChild: '5'; hRigid: false; vRigid: false) inset bordered;
            addChild: (TextInteractor new addChild: '6'; hRigid: false; vRigid: true) inset bordered);
        addChild: (ColumnInteractor new
            addChild: (TextInteractor new addChild: '7'; hRigid: true; vRigid: true) inset bordered;
            addChild: (TextInteractor new addChild: '8'; hRigid: true; vRigid: false) inset bordered;
            addChild: (TextInteractor new addChild: '9'; hRigid: true; vRigid: true) inset bordered)!

complexInteractor3
    ^ColumnInteractor new
        addChild: self complexInteractor;
        addChild: self complexInteractor2;
        addChild: self complexInteractor!

complexInteractor4
    ^RowInteractor new
        addChild: self complexInteractor3;
        addChild: self complexInteractor3;
        addChild: self complexInteractor3!

exampleImage

    | image bits |
    image := Image parcPlaceLogo shrunkenBy: 2@2.
    bits := image bitsInstVar.
    1 to: bits size do: [ :i | bits at: i put: 255 - (bits at: i)].
    ^image!

exampleString

    ^
'People prefer to refer to hosts using a name rather than a
string of digits.  So IP implementations usually have some sort of
name-to-address directory in which an address can be looked up
dynamically.

To deal with the case where you have a host number but no name,
all the routines which deal with host names (which are Strings) can
accept numeric strings in canonical format (i.e. 192.9.100.4).

The class protocol ''naming utilities'' has methods to convert to/from
host-names and host-addresses.
'!

fillerInteractor
    ^FillerInteractor new!

silly

    | window bounds o1 o2 p1 p2 d1 d2 gc r sensor |
    r := Random new.
    bounds := (window := Window currentWindow) bounds.
    gc := window graphicsContext.
    gc lineWidth: 25.
    sensor := window sensor.
    p1 := 0.0@0.0.
    p2 := 0.0@0.0.
    d1 := r next @ r next.
    d2 := r next @ r next.
    [sensor redButtonPressed not] whileTrue: [
        gc    paint: ColorValue black;
            displayLineFrom: (p1 x asInteger)@(p1 y asInteger) to: (p2 x asInteger)@(p2 y asInteger).
        o1 := p1 copy.
        o2 := p2 copy.
        p1 := p1 + d1.
        p2 := p2 + d2.
        p1 x > bounds corner x ifTrue: [d1 x: d1 x negated].
        p1 y > bounds corner y ifTrue: [d1 y: d1 y negated].
        p2 x > bounds corner x ifTrue: [d2 x: d2 x negated].
        p2 y > bounds corner y ifTrue: [d2 y: d2 y negated].
        p1 x < bounds origin x ifTrue: [d1 x: d1 x negated].
        p1 y < bounds origin y ifTrue: [d1 y: d1 y negated].
        p2 x < bounds origin x ifTrue: [d2 x: d2 x negated].
        p2 y < bounds origin y ifTrue: [d2 y: d2 y negated].
        gc paint: ColorValue white;
            displayLineFrom: (o1 x asInteger)@(o1 y asInteger) to: (o2 x asInteger)@(o2 y asInteger)].
    window refresh! !

!Interactor class methodsFor: 'development support'!

closeCorpses

    (StandardSystemController allInstances select: [ :ctrl | ctrl model class == RootInteractor]) do: [ :ctrl | ctrl close]!

fallin: dict from: object

    | i |
    (i := object allInstances) isEmpty ifFalse: [dict at: object printString asSymbol put: i]!

inspectFallout

    | a |
    ObjectMemory compactingGC; globalGarbageCollect.
    a := self snarfFallout.
    a isEmpty ifFalse: [a inspect]!

releaseFallout

    | snarf |
    ((snarf := self snarfFallout) at: #RootInteractor ifAbsent: [#()]) do:
        [ :root | root window isNil ifFalse: [root window close]].
    snarf  do: [ :c | c do: [ :x | x release]].
    self inspectFallout!

snarfFallout

    | a |
    Cursor execute showWhile: [
        a := Dictionary new.
        self
            fallin: a from: ActiveInteractor;
            fallin: a from: ColumnInteractor;
            fallin: a from: CompositeInteractor;
            fallin: a from: FillerInteractor;
            fallin: a from: Interactor;
            fallin: a from: InteractorController;
            fallin: a from: InteractorView;
            fallin: a from: MVCInteractor;
            fallin: a from: StemInteractor;
            fallin: a from: RootInteractor;
            fallin: a from: RowInteractor;
            fallin: a from: CachedScrollingInteractor;
            fallin: a from: ScrollingInteractor;
            fallin: a from: SimpleInteractor;
            fallin: a from: HScrollbar;
            fallin: a from: HScroller;
            fallin: a from: PButton;
            fallin: a from: PScrollbar;
            fallin: a from: PScroller;
            fallin: a from: ScrollerSensor;
            fallin: a from: VScrollbar;
            fallin: a from: VScroller].
    ^a! !

!Interactor class methodsFor: 'fileIn/Out'!

fileOutInteractors

    #('Interactors-Framework' 'Interactors-Scrolling' 'Interactors-Support' 'Interactors-PenPad')
        do: [:category || file |
                file := SourceCodeStream on: (category, '.st') asFilename writeStream.
                [Smalltalk organization fileOutCategorySource: category on: file]
                    valueNowOrOnUnwindDo: [file close]]! !

!Interactor class methodsFor: 'development utilitites'!

allAccessesTo: instVarName
    | coll |
    coll := OrderedCollection new.
    Cursor execute showWhile: [
        self allSubclasses
            add: self;
            do: [:class | (class whichSelectorsAccess: instVarName) do: [:sel | coll add: class name , ' ' , sel]]].
    ^coll!

allCallsOn: aLiteral
    | aSortedCollection |
    aSortedCollection := SortedCollection new.
    Cursor execute showWhile:
        [self allSubclasses
            add: self;
            do: [:class | (class whichSelectorsReferTo: aLiteral) do:
                            [:sel | aSortedCollection add: class name , ' ' , sel]]].
    ^aSortedCollection!

allImplementorsOf: aSelector
    | aCollection |
    aCollection := SortedCollection new.
    Cursor execute showWhile:
        [self allSubclasses
            add: self;
            do: [:class | (class includesSelector: aSelector)
                            ifTrue: [aCollection add: class name, ' ', aSelector]]].
    ^aCollection!

browseAllAccesses
    self browseAllAccessesTo: (DialogView request: 'browse which instance variable?')!

browseAllAccessesTo: instanceVariable
    ^MethodListBrowser
        openListBrowserOn: (self allAccessesTo: instanceVariable)
        label: instanceVariable
        initialSelection: instanceVariable!

browseAllImplementors
    self browseAllImplementorsOf: (DialogView request: 'browse implementors of which selector?') asSymbol!

browseAllImplementorsOf: selector
    MethodListBrowser
        openListBrowserOn: (self allImplementorsOf: selector)
        label: 'Implementors of ' , selector!

browseAllSenders
    self browseAllSendersOf: (DialogView request: 'browse senders of which selector?') asSymbol!

browseAllSendersOf: aSymbolOrAssociation
    | label key selection |
    (aSymbolOrAssociation isMemberOf: Association)
        ifTrue: [key := aSymbolOrAssociation key.
                label := 'Users of ' , key asString.
                selection := key]
        ifFalse: [key := aSymbolOrAssociation.
                label := 'References to ', key asString.
                selection := key asSymbol keywords first].


    ^ MethodListBrowser
        openListBrowserOn: (self allCallsOn: aSymbolOrAssociation)
        label: label
        initialSelection: selection!

compareClass: classA with: classB
    | selectorsA selectorsB notInA notInB report commonSelectors |
    report := WriteStream on: (String new: 256).
    selectorsA := classA selectors.
    selectorsB := classB selectors.
    notInA := selectorsB select: [ :sel | (selectorsA includes: sel) not].
    notInB := selectorsA select: [ :sel | (selectorsB includes: sel) not].
    report nextPutAll: 'selectors missing in ' , classA printString , ':'.
    notInA do: [ :sel | report crtab; nextPutAll: sel asString].
    report cr; cr; nextPutAll: 'selectors missing in ' , classB printString , ':'.
    notInB do: [ :sel | report crtab; nextPutAll: sel asString].
    report cr; cr; nextPutAll: 'changed methods'.
    commonSelectors := selectorsA asSet addAll: selectorsB asSet.
    commonSelectors removeAll: notInA asSet.
    notInB asSet do: [ :sel | (commonSelectors includes: sel) ifTrue: [commonSelectors remove: sel]].
    commonSelectors do: [ :sel |
        (Interactor compiledMethod: (classA compiledMethodAt: sel) hasBytesOf: (classB compiledMethodAt: sel))
            ifFalse: [report crtab; nextPutAll: sel printString]].
    report cr.
    ^report contents!

compiledMethod: cm1 hasBytesOf: cm2
    cm1 basicSize == cm2 basicSize ifFalse: [^false].
    1 to: cm1 basicSize do: [ :index | (cm1 basicAt: index) == (cm2 basicAt: index) ifFalse: [^false]].
    ^true! !

Interactor subclass: #RootInteractor
    instanceVariableNames: 'label lookPreferences component previousSelectionPoint previousSelectionInteractor previousSelectionTime '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!RootInteractor methodsFor: 'initialize-release'!

initialize
    self previousSelectionTime: Time millisecondClockValue.
    super initialize.
    self lookPreferences: LookPreferences defaultForWindows!

release
    component release.
    component := previousSelectionInteractor := nil.
    super release! !

!RootInteractor methodsFor: 'hierarchy'!

installComposites

    component installComposites!

installHierarchy

    "The installation of parents should be distributed accross the addition of
    children, with each parent handling the installation of itself as the guardian
    of its offspring."

    component parent: self; installHierarchy.
    "self hierarchyString inspect"!

installSensor: aSensor

    self sensor: aSensor.
    component installSensor: aSensor! !

!RootInteractor methodsFor: 'accessing'!

addChild: c
    component isNil
        ifFalse: [self error: 'Duplicate component in RootInteractor!!']
        ifTrue: [self component: c]!

addChild: child beforeClass: class
    ^self addChild: child!

bounds
    ^Point zero extent: self extent!

component
    ^component!

component: c
    component := c!

graphicsContext
    ^self window graphicsContext!

graphicsContextFor: anInteractor
    ^self graphicsContext!

lookPreferences
    ^lookPreferences!

lookPreferences: lp
    lookPreferences := lp!

minimumExtent
    ^self extent!

previousSelectionInteractor
    ^previousSelectionInteractor!

previousSelectionInteractor: aInteractor
    previousSelectionInteractor := aInteractor!

previousSelectionPoint
    ^previousSelectionPoint!

previousSelectionPoint: aPoint
    previousSelectionPoint := aPoint!

previousSelectionTime
    ^previousSelectionTime!

previousSelectionTime: aTime
    previousSelectionTime := aTime!

rootInteractor!

windowLabel
    ^label isNil
        ifTrue: ['Interact with me!!']
        ifFalse: [label]!

windowLabel: l
    label := l.
    self setLabel! !

!RootInteractor methodsFor: 'scheduling'!

open
    "This is the big crunch - compose the component, create
    a Pixmap to hold the visual representation, then create
    and schedule a window to realize the interactor."

    | view |
    self
        installComposites;
        installHierarchy;
        defaultExtent: component computeExtent.
    window := ScheduledWindow new.
    self component installWindow: window.
    (component computeBounds: (0@0 extent: self extent)) area < 100 ifTrue: [self uimsError].
    view := InteractorView model: self interactor: self.
    window controller model: view model.
    window component: view.
    self setLabel.
    window minimumSize: component extent.
    self graphicsContext font: FontDescription default.
    self installSensor: window sensor.
    "component renderOn: self graphicsContext."
    window open!

setLabel

    self window isNil ifFalse: [self window label: self windowLabel]! !

!RootInteractor methodsFor: 'resizing'!

displayOn: aGC

    aGC font: FontDescription default.
    component renderOn: aGC!

recompose
    component computeExtent.
    ^self recomposeIn: self bounds!

recomposeIn: newBounds
    "My window has changed extent - rebuild my pixmap, recompose my
    interior, then redisplay myself."

    | gc |
    self extent: newBounds extent.
    component computeBounds: newBounds.
    (gc := self graphicsContext) font: FontDescription default.
    "component renderOn: gc."
    "gc flush"! !

!RootInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i

    aStream crtab: i; nextPutAll: 'Root ' , self auxiliaryPrintInfo.
    component printHierarchyOn: aStream indent: i+1! !

!RootInteractor methodsFor: 'event enquiry'!

interactorAt: aPoint

    ^component interactorAt: aPoint! !

!RootInteractor methodsFor: 'event response'!

keyboardDown: aPoint

    | actor |
    (actor := self interactorAt: aPoint) notNil
        ifTrue: [actor keyboardDown]
        ifFalse: [self error: 'default keyboard processing not installed!!!!!!']!

operateDown: aPoint

    | actor |
    (actor := self interactorAt: aPoint) notNil ifTrue: [actor operateDown]!

selectDown: aPoint

    | actor |
    (actor := self interactorAt: aPoint) notNil
        ifTrue:
            [(self previousSelectionPoint = aPoint
                    and: [self previousSelectionInteractor = actor
                    and: [Time millisecondClockValue - self previousSelectionTime < self selectionDelay]])
                ifTrue: [actor selectDownDown]
                 ifFalse: [actor selectDown]].
    self
        previousSelectionPoint: aPoint;
        previousSelectionInteractor: actor;
        previousSelectionTime: Time millisecondClockValue!

startUp: aPoint

    | actor |
    (actor := self interactorAt: aPoint) notNil ifTrue: [actor startUp]! !

!RootInteractor methodsFor: 'rendering'!

damaged

    "If double buffering is in use, update the view on the screen based on the
    current damage; otherwise ignore."

    "self flush"! !

!RootInteractor methodsFor: 'look and feel'!

selectionDelay
    ^200 "ms"! !

!RootInteractor methodsFor: 'testing'!

hasIndirectParent: anInteractor
    ^self == anInteractor! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

RootInteractor class
    instanceVariableNames: ''!


!RootInteractor class methodsFor: 'instance creation'!

on: anInteractor
    ^self new addChild: ("MessageLogger on:" anInteractor "excluding: #(interactorAt:)")! !

Interactor subclass: #StemInteractor
    instanceVariableNames: 'parent origin preferredExtent hStretch vStretch '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!
StemInteractor comment:
'parent                (Representation) the composite representation of which I am part
topInteractor        (Interactor) the root of the interactor hierarchy of which I am part
origin                (Point) my origin in window-relative coordinates
preferredExtent    (Point) my default (usually smallest) size

[v|h]Stretch            (Boolean) true if I wish to stay my default size, false if I can be stretched.
                    One each for horizontal and vertical directions. This may be extended in
                    future to allow a "stretchiness" value rather than just a binary flag.'!


!StemInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    origin := 0@0.
    vStretch := hStretch := true!

release
    parent := nil.
    super release! !

!StemInteractor methodsFor: 'accessing-geometry'!

bounds
    ^self origin extent: self extent!

bounds: bBox
    bBox extent >= self minimumExtent ifFalse: [self error: 'attempt to set bounds smaller than minimum'].
    self
        origin: bBox origin;
        extent: bBox extent.
    ^bBox!

corner
    ^self origin + self extent!

minimumExtent
    ^preferredExtent isNil
        ifTrue: [Point zero]
        ifFalse: [preferredExtent copy]!

minimumExtent: e
    preferredExtent := e!

origin
    ^origin!

origin: aPoint
    origin := aPoint!

preferredExtent: e
    ^preferredExtent := e max: self minimumExtent!

preferredHeight
    ^self minimumExtent y!

preferredWidth
    ^self minimumExtent x! !

!StemInteractor methodsFor: 'accessing-elasticity'!

elastic: r
    self hElastic: r; vElastic: r!

hElastic
    ^hStretch!

hElastic: f
    hStretch := f!

hRigid
    ^hStretch not!

hRigid: f
    hStretch := f not!

rigid
    self rigid: true!

rigid: r
    self hRigid: r; vRigid: r!

vElastic
    ^vStretch!

vElastic: f
    vStretch := f!

vRigid
    ^vStretch not!

vRigid: f
    vStretch := f not! !

!StemInteractor methodsFor: 'accessing'!

addChild: aChild beforeClass: aClass
    "overridden for composites of all flavors..."

    ^self addChild: aChild!

parent
    ^parent!

parent: p
    parent := p!

transparentParent
    ^parent! !

!StemInteractor methodsFor: 'event support'!

selectButtonPressed
    "The select button is considered released if either the redButton is inactive or the cursor is outside the receiver's bounds"

    ^self sensor redButtonPressed and: [self bounds containsPoint: self sensor cursorPoint]! !

!StemInteractor methodsFor: 'testing'!

hasIndirectParent: anInteractor
    ^anInteractor == self or: [self parent hasIndirectParent: anInteractor]! !

StemInteractor subclass: #SliderInteractor
    instanceVariableNames: 'valueBlock minVal maxVal ticks currentValue sliderBounds valueBounds incrementSize '
    classVariableNames: 'DefaultIncrement '
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!SliderInteractor methodsFor: 'initialize-release'!

initialize
    self
        valueBlock: [ :i :x ];
        minVal: 0;
        maxVal: 100;
        ticks: 10;
        incrementSize: self defaultIncrement.
    super initialize! !

!SliderInteractor methodsFor: 'geometry'!

computeBounds: b
    | vbox |
    vbox := self maxVal printString asComposedText bounds.
    vbox := vbox translatedBy: b origin.
    self sliderBounds: ((vbox topRight + (self edgeSpace@0) corner: b corner) insetBy: self edgeSpace).
    self valueBounds: (vbox translatedBy: (self edgeSpace - 1)@(b extent y - vbox height) // 2).
    ^self bounds: b!

computeExtent
    ^self preferredExtent: 200@20! !

!SliderInteractor methodsFor: 'accessing'!

clearValue
    self currentValue: nil; render.
    self valueBlock value: self value: nil!

currentOrMaxValue
    ^self currentValue isNil ifTrue: [self maxVal] ifFalse: [self currentValue]!

currentOrMinValue
    ^self currentValue isNil ifTrue: [self minVal] ifFalse: [self currentValue]!

currentValue
    ^currentValue!

currentValue: aNumber
    currentValue := aNumber isNil ifFalse: [self constrain: aNumber]!

decrement
    self decrement: self incrementSize!

decrement: aNumber

    self newValue: self currentOrMaxValue - aNumber!

defaultIncrement
    ^DefaultIncrement!

increment
    self increment: self incrementSize!

increment: aNumber
    self newValue: self currentOrMinValue + aNumber!

incrementSize
    ^incrementSize!

incrementSize: aNumber
    incrementSize := aNumber!

maxVal
    ^maxVal!

maxVal: aNumber
    maxVal := aNumber!

minVal
    ^minVal!

minVal: aNumber
    minVal := aNumber!

newValue: aNumber

    | gc newVal |
    newVal := self constrain: aNumber.
    self currentValue = newVal
        ifFalse:
            [gc := self graphicsContext.
            (self
                invalidateSliderOn: gc;
                currentValue: newVal;
                renderSliderOn: gc;
                renderValueOn: gc;
                valueBlock) value: self value: currentValue]!

sliderBounds
    ^sliderBounds!

sliderBounds: bb
    sliderBounds := bb!

ticks
    ^ticks!

ticks: anInteger
    "0 turns the ticking off"

    ticks := anInteger!

valueBlock
    ^valueBlock!

valueBlock: vb
    valueBlock := vb!

valueBounds
    ^valueBounds!

valueBounds: bb
    valueBounds := bb! !

!SliderInteractor methodsFor: 'rendering'!

renderForegroundOn: aGC

    self
        renderSliderOn: aGC;
        renderValueOn: aGC! !

!SliderInteractor methodsFor: 'event response'!

keyboardDown

    [self sensor keyboardPressed]
        whileTrue: [self processChar: self sensor keyboardEvent keyValue]!

selectDown

    (self bounds containsPoint: self sensor cursorPoint)
        ifTrue: [self trackButton]!

trackButton

    [self sensor redButtonPressed]
        whileTrue:
            [self newValue: (self sensor cursorPoint x - self sliderBounds left
                                / self sliderBounds width
                                * (self maxVal - self minVal) + self minVal)]! !

!SliderInteractor methodsFor: 'keyboard processing'!

processChar: char

    char isDigit
        ifTrue: [self processDigit: char asInteger - $0 asInteger]
        ifFalse: [char asInteger == 127 ifTrue: [self processDelete]]!

processDelete
    self currentValue notNil
        ifTrue:
            [self currentValue < 10
                ifTrue: [self clearValue]
                ifFalse: [ | newVal |
                    newVal := self currentValue // 10.
                    newVal < self minVal
                        ifTrue: [self clearValue]
                        ifFalse: [self newValue: newVal]]]!

processDigit: num

    | newVal |
    newVal := self currentValue isNil
        ifTrue: [num]
        ifFalse: [self currentValue * 10 + num].
    self newValue: newVal! !

!SliderInteractor methodsFor: 'look and feel'!

edgeSpace
    "an ABSOLUTE number of pixels"
    ^5!

lineWidth
    ^1!

minorHeight
    "a FACTOR of minor:major ticks"
    ^0.8!

sliderHeight
    "a FACTOR of slider:window height"
    ^0.8!

sliderWidth
    "an ABSOLUTE slider width in pixels"
    ^3! !

!SliderInteractor methodsFor: 'private-geometry'!

maxValText
    ^self maxVal printString asComposedText! !

!SliderInteractor methodsFor: 'private-rendering'!

buttonBounds

    | sliderx slidery |
    sliderx := self currentValue - self minVal / (self maxVal - self minVal) * self sliderBounds width + self sliderBounds origin x.
    slidery := (self sliderBounds height / 2 * self sliderHeight) asInteger.
    ^((sliderx - (self sliderWidth // 2))@(self sliderBounds center y - slidery) extent: (self sliderWidth@(slidery * 2)))!

invalidateSliderOn: aGC

    | paint |
    self currentValue notNil
        ifTrue:
            [paint := aGC paint.
            aGC
                paint: aGC medium background;
                displayRectangle: self buttonBounds;
                paint: paint]!

renderSliderOn: aGC

    | midline left right major minor bbox |
    bbox := self sliderBounds.
    left := bbox left.
    right := bbox right.
    major := bbox height // 2.
    minor := (major * self minorHeight) asInteger.
    midline := bbox center y.
    aGC
        lineWidth: self lineWidth * 2;
        displayLineFrom: left@(midline - major) to: left@(midline + major);
        displayLineFrom: right@(midline - major) to: right@(midline + major);
        lineWidth: self lineWidth;
        displayLineFrom: left@midline to: right@midline.
    ticks > 0 ifTrue: [ | gap |
        gap := bbox width / self ticks.
        1 to: self ticks do: [ :x | aGC displayLineFrom: (x * gap + left)@(midline - minor) to: (x * gap + left)@(midline)]].

    self currentValue notNil ifTrue: [aGC displayRectangle: self buttonBounds]!

renderValueOn: aGC

    | paint visual |
    visual := (self currentValue isNil ifTrue: ['?'] ifFalse: [self currentValue printString]) asComposedText.
    paint := aGC paint.
    aGC
        paint: aGC medium background;
        displayRectangle: self valueBounds;
        paint: paint;
        display: visual
            at: (self valueBounds origin translatedBy: self valueBounds extent - visual extent // 2)! !

!SliderInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i
    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo! !

!SliderInteractor methodsFor: 'private'!

constrain: aNumber
    ^(aNumber asInteger max: self minVal) min: self maxVal! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SliderInteractor class
    instanceVariableNames: ''!


!SliderInteractor class methodsFor: 'class initialization'!

initialize
    DefaultIncrement := 1! !

SliderInteractor subclass: #FixedPointSliderInteractor
    instanceVariableNames: 'scaling '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!FixedPointSliderInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self scaling: 10! !

!FixedPointSliderInteractor methodsFor: 'geometry'!

computeBounds: b
    | vbox |
    vbox := ((self maxVal * self scaling) printString , '.') asComposedText bounds.
    vbox := vbox translatedBy: b origin.
    self sliderBounds: ((vbox topRight + (self edgeSpace@0) corner: b corner) insetBy: self edgeSpace).
    self valueBounds: (vbox translatedBy: (self edgeSpace - 1)@(b extent y - vbox height) // 2).
    ^self bounds: b! !

!FixedPointSliderInteractor methodsFor: 'accessing'!

scaling
    ^scaling!

scaling: aNumber
    scaling := aNumber! !

!FixedPointSliderInteractor methodsFor: 'private'!

constrain: aNumber
    ^((((aNumber max: self minVal) min: self maxVal) * self scaling) asInteger / self scaling) asFloat! !

StemInteractor subclass: #PrimitiveInteractor
    instanceVariableNames: 'component '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!PrimitiveInteractor methodsFor: 'initialize-release'!

release
    self component release.
    self component: nil.
    super release! !

!PrimitiveInteractor methodsFor: 'accessing'!

addChild: c

    self component isNil
        ifFalse: [self error: 'Duplicate interactor']
        ifTrue: [self component: c]! !

!PrimitiveInteractor methodsFor: 'private-accessing'!

component
    ^component!

component: brat

    component := brat!

transparentComponent
    ^component! !

!PrimitiveInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i
    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo , ' on: ' , component printString! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PrimitiveInteractor class
    instanceVariableNames: ''!


!PrimitiveInteractor class methodsFor: 'instance creation'!

addChild: aComponent
    ^self new addChild: aComponent!

on: aComponent
    "OBSOLETE -- VERY VERY NAUGHTY TO USE THIS!!"

    ^self new addChild: aComponent! !

PrimitiveInteractor subclass: #SimpleInteractor
    instanceVariableNames: 'justification '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!SimpleInteractor methodsFor: 'initialize-release'!

initialize
    self justification: #center.
    ^super initialize! !

!SimpleInteractor methodsFor: 'geometry'!

computeBounds: bounds
    ^self bounds: bounds! !

!SimpleInteractor methodsFor: 'accessing'!

addChild: aThing
    self component: aThing!

justification
    ^justification!

justification: aSymbol
    justification := aSymbol! !

!SimpleInteractor methodsFor: 'rendering'!

renderForegroundOn: gc

    gc display: self component at: self justifiedOrigin! !

!SimpleInteractor methodsFor: 'private'!

justifiedOrigin

    | originX originY |
    originY := self origin y + ((self extent y - self component extent y) // 2).
    originX := (self justification == #left
        ifTrue: [self origin x] ifFalse: [self justification == #center
        ifTrue: [self origin x + ((self extent x - self component extent x) // 2)] ifFalse: [self justification == #right
        ifTrue: [self corner x - self component extent x] ifFalse: [self uimsError]]]).
    ^originX@originY! !

SimpleInteractor subclass: #ImageInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!ImageInteractor methodsFor: 'geometry'!

computeExtent

    ^self preferredExtent: (self minimumExtent max: self component extent)! !

!ImageInteractor methodsFor: 'rendering'!

renderDeselectedOn: aGC
    self component depth == 1 ifTrue: [self component palette: MappedPalette whiteBlack].
    super renderDeselectedOn: aGC!

renderSelectedOn: aGC
    self component depth == 1 ifTrue: [self component palette: MappedPalette blackWhite].
    super renderSelectedOn: aGC! !

SimpleInteractor subclass: #TextInteractor
    instanceVariableNames: 'textConvertor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!TextInteractor methodsFor: 'geometry'!

computeBounds: bbox
    ^super computeBounds: bbox!

computeExtent
    ^self preferredExtent: (self minimumExtent max: (self component textStyle: (TextAttributes default)) extent)! !

!TextInteractor methodsFor: 'accessing'!

addChild: aTextOrString

    super addChild: aTextOrString asComposedText!

component
    ^self textConvertor isNil
        ifTrue: [super component]
        ifFalse: [(self textConvertor value: super component string) asComposedText]!

textConvertor
    ^textConvertor!

textConvertor: tc
    textConvertor := tc!

textStyle: ts! !

!TextInteractor methodsFor: 'rendering'!

graphicsContextFor: aComponent

    ^(super graphicsContextFor: aComponent) font: self font! !

!TextInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i
    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo , ' on: ' , component string printString! !

TextInteractor subclass: #WrappedTextInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!WrappedTextInteractor methodsFor: 'geometry'!

computeBounds: bbox
    self component compositionWidth: bbox width.
    ^super computeBounds: bbox!

computeExtent
    self minimumExtent x > 0 ifTrue: [self component compositionWidth: self minimumExtent x].
    ^super computeExtent! !

SimpleInteractor subclass: #ObjectInteractor
    instanceVariableNames: 'displayConvertor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!ObjectInteractor methodsFor: 'geometry'!

computeBounds: b
    ^self bounds: b!

computeExtent
    ^self preferredExtent: (self component extent max: self minimumExtent)! !

!ObjectInteractor methodsFor: 'accessing'!

component
    ^self displayConvertor isNil
        ifTrue: [super component]
        ifFalse: [(self displayConvertor value: super component) asComposedText]!

displayConvertor
    ^displayConvertor!

displayConvertor: aUnaryBlock
    displayConvertor := aUnaryBlock! !

PrimitiveInteractor subclass: #MVCInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!MVCInteractor methodsFor: 'hierarchy'!

installHierarchy

    component container: self! !

!MVCInteractor methodsFor: 'geometry'!

computeBounds: bounds

    self bounds: bounds.
    self component bounds: bounds.
    ^self bounds!

computeExtent
    "Make an informed guess..."

    ^self preferredExtent: (ComposedText new lineGrid) asPoint! !

!MVCInteractor methodsFor: 'accessing'!

addChild: aThing
    self component: aThing! !

!MVCInteractor methodsFor: 'rendering'!

renderForegroundOn: aGC
    | rect |
    rect := self bounds.
    rect origin: rect origin + (1@1).
    rect corner: rect corner - self cornerCorrection.
    aGC
        paint: self backgroundColor;
        displayRectangle: rect;
        clippingRectangle: rect.
    self component displayOn: aGC at: self origin.
    aGC clippingRectangle: nil! !

!MVCInteractor methodsFor: 'event processing'!

selectDown

    self component startUp!

startUp

    "Pseudo-event sent periodically by the RootInteractor to let Interactors
    with multiple personalities (such as ourselves) a chance to start up the
    control loop in our underlying controller..."

    ^self component startUp! !

!MVCInteractor methodsFor: 'mvc messages'!

changedPreferredBounds: foo forComponent: bar!

compositionBoundsFor: anObject

    ^Point zero corner: self extent - self cornerCorrection!

edgeDecorationPolicy

    ^window edgeDecorationPolicy!

graphicsContextFor: anObject

    ^self graphicsContext
        translateBy: self origin;
        clippingRectangle: (self compositionBoundsFor: anObject)!

isOpen
    ^window isOpen!

localPointToGlobal: aPoint

    ^aPoint + self origin!

lookPreferences

    ^self window lookPreferences!

topComponent

    ^self window! !

MVCInteractor subclass: #InputFieldInteractor
    instanceVariableNames: 'acceptBlock '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!InputFieldInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self addChild: (TextFieldView new initializeSelection)! !

!InputFieldInteractor methodsFor: 'accessing'!

acceptBlock
    ^acceptBlock!

acceptBlock: aBlock
    acceptBlock := aBlock!

addChild: sprog
    super addChild: sprog.
    sprog bounds: self bounds.
    sprog initializeSelection!

setText: aTextOrString
    self component
        deselect;
        editText: aTextOrString asText;
        initializeSelection;
        selectionIndex: aTextOrString size + 1! !

!InputFieldInteractor methodsFor: 'event response'!

accepted
    self acceptBlock value: self value: self component displayContents text string! !

StemInteractor subclass: #LinearInteractor
    instanceVariableNames: 'component '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!LinearInteractor methodsFor: 'initialize-release'!

release
    self component release.
    self component: nil.
    super release! !

!LinearInteractor methodsFor: 'hierarchy'!

installComposites
    self component installComposites!

installHierarchy

    component parent: self.
    component installHierarchy.
    super installHierarchy.!

installSensor: aWin

    component installSensor: aWin.
    super installSensor: aWin!

installWindow: aWin

    component installWindow: aWin.
    super installWindow: aWin! !

!LinearInteractor methodsFor: 'accessing'!

addChild: c

    self component isNil
        ifFalse: [self error: 'Duplicate interactor']
        ifTrue: [self component: c]!

component
    ^component!

component: brat

    component := brat!

installChild

    (self
        installHierarchy;
        installSensor: self sensor;
        installWindow: self window;
        computeExtent;
        computeBounds: self bounds;
        component) damaged.
    self render!

selected: flag
    super selected: flag.
    self component selected: flag!

transparentComponent
    ^component! !

!LinearInteractor methodsFor: 'default behavior'!

interactorAt: aPoint

    ^self component interactorAt: aPoint! !

!LinearInteractor methodsFor: 'rendering'!

renderOn: aGC
    super renderOn: aGC.
    self component renderOn: aGC! !

!LinearInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i
    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo.
    self component printHierarchyOn: aStream indent: i+1! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

LinearInteractor class
    instanceVariableNames: ''!


!LinearInteractor class methodsFor: 'instance creation'!

addChild: aComponent
    ^self new addChild: aComponent!

on: aComponent
    ^self new addChild: aComponent! !

LinearInteractor subclass: #ScrollingInteractor
    instanceVariableNames: 'offset visibleExtent hScroller vScroller '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!
ScrollingInteractor comment:
'I wrap up an almost autonomous collection of interactors that can be scrolled arbitrarily, in any combination of horizontal and vertical directions. I cache the visual representation of my components so that they do not have to render themselves entirely onto my graphicsContext within some clipping rectangle every time they are scrolled.  There are obviously some updating issues to be addressed here, since updates into the localPixmap must also make it onto the enclosing pixmap.

component                (Interactor) the interactor which I scroll

offest                    (Point) the offset (due to scrolling) of my component

visibleExtent            (Point) the amout of the localPixmap (from the offset) that can be
                        seen (excludes the scrollbars)

localPixmap            (Pixmap) the cached visual representation of my component

localGraphicsContext    (GraphicsContext) a cached graphicsContext on the localPixmap

[h|v]Scroller                ([Horizontal | Vertical]Scrollbar) either the relevant type of scrollbar,
                        or nil for no scrollbar in that dimension

rendered                (Boolean) true if the component has already rendered itself on the localPixmap'!


!ScrollingInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self offset: 0@0!

useBothScrollers

    self useHorizontalScroller; useVerticalScroller!

useHorizontalScroller

    hScroller := HScroller new target: self!

useVerticalScroller

    vScroller := VScroller new target: self! !

!ScrollingInteractor methodsFor: 'hierarchy'!

installSensor: aSensor

    self sensor: aSensor.
    component installSensor: (ScrollerSensor new setWindow: window windowSensor: aSensor).
    component sensor globalOrigin: self origin + (self scrollerCorrection x @ 0).
    hScroller isNil ifFalse: [hScroller installSensor: aSensor].
    vScroller isNil ifFalse: [vScroller installSensor: aSensor].! !

!ScrollingInteractor methodsFor: 'accessing'!

hScroller
    ^hScroller!

hScroller: s
    hScroller := s!

offset
    ^offset!

offset: o
    offset := o!

visibleExtent
    ^visibleExtent!

visibleExtent: ve
    visibleExtent := ve!

vScroller
    ^vScroller!

vScroller: s
    vScroller := s! !

!ScrollingInteractor methodsFor: 'geometry'!

computeBounds: bounds

    | ve ce sc |
    self visibleExtent: (ve := bounds extent - (sc := self scrollerCorrection)).
    ce := self component minimumExtent.
    "(ve x < ce x or: [ve y < ce y]) ifTrue: [self uimsError]."
    self bounds: bounds.
    self component computeBounds: (0@0 extent:
            (self component hRigid ifTrue: [ce x] ifFalse: [ce x max: ve x]) @
            (self component vRigid ifTrue: [ce y] ifFalse: [ce y max: ve y])).
    self
        offset: 0@0;
        setRanges;
        setBars.

    vScroller notNil ifTrue: [vScroller bounds: (bounds origin corner: 1@-1 * sc + bounds bottomLeft + (0@1))]. "ASSUMES V-SCROLLERS ON THE LEFT!!!!!!"

    hScroller notNil ifTrue: [hScroller bounds: (1@-1 * sc + bounds bottomLeft - (1@0) corner: bounds corner)].
    ^self bounds!

computeExtent
    self component computeExtent.
    ^self minimumExtent max: 50@50! !

!ScrollingInteractor methodsFor: 'rendering'!

graphicsContextFor: aComponent
    | visibleOrigin |
    visibleOrigin := self scrollerCorrection x @ 0 + self origin.
    ^self graphicsContext
        clippingRectangle: (visibleOrigin extent: self visibleExtent);
        translateBy:  visibleOrigin - self offset!

renderInactiveRegionOn: gc

    (vScroller notNil and: [hScroller notNil])
        ifTrue: [gc
                paint: self selectionBackgroundColor;
                displayRectangle: (vScroller bounds bottomLeft corner: hScroller bounds bottomLeft)]!

renderOn: gc

    self component renderOn: (self graphicsContextFor: self component).

    vScroller notNil ifTrue: [vScroller renderOn: gc].
    hScroller notNil ifTrue: [hScroller renderOn: gc].

    self renderInactiveRegionOn: gc! !

!ScrollingInteractor methodsFor: 'private'!

scrollerCorrection

    ^((self vScroller notNil ifTrue: [vScroller width] ifFalse: [0])
    @(self hScroller notNil ifTrue: [hScroller height] ifFalse: [0]))!

setBars
    "set the size and position of the two scrollbars"

    vScroller isNil ifFalse: [vScroller
        min: offset y;
        max: offset y + self visibleExtent y].
    hScroller isNil ifFalse: [hScroller
        min: offset x;
        max: offset x + self visibleExtent x].!

setRanges
    "set the ranges of the two scrollbars"

    vScroller isNil ifFalse: [vScroller range: self component extent y].
    hScroller isNil ifFalse: [hScroller range: self component extent x]! !

!ScrollingInteractor methodsFor: 'scrolling'!

scrollBy: aPoint

    | newOffset corner componentExtent oldOffset |
    aPoint isZero
        ifFalse:
            [oldOffset := self offset.
            newOffset := aPoint * self warpFactor + self offset.
            corner := newOffset + self visibleExtent.
            componentExtent := self component extent.
            corner x > componentExtent x ifTrue: [corner x: componentExtent x].
            corner y > componentExtent y ifTrue: [corner y: componentExtent y].
            corner x < self visibleExtent x ifTrue: [corner x: self visibleExtent x].
            corner y < self visibleExtent y ifTrue: [corner y: self visibleExtent y].
            self offset: corner - self visibleExtent.
            self component sensor translateOrigin: oldOffset - self offset.
            self
                renderOn: self parent graphicsContext;
                setBars;
                damaged]!

scrollDown
    self scrollBy: 0@1!

scrollLeft
    self scrollBy: -1@0!

scrollRight
    self scrollBy: 1@0!

scrollTo: aPoint

    | corner componentExtent oldOffset |
    oldOffset := self offset.
    corner := aPoint + self visibleExtent.
    componentExtent := self component extent.
    corner x > componentExtent x ifTrue: [corner x: componentExtent x].
    corner y > componentExtent y ifTrue: [corner y: componentExtent y].
    corner x < self visibleExtent x ifTrue: [corner x: self visibleExtent x].
    corner y < self visibleExtent y ifTrue: [corner y: self visibleExtent y].
    self offset: corner - self visibleExtent.
    self component sensor translateOrigin: oldOffset - self offset.
    self
        renderOn: self parent graphicsContext;
        setBars;
        damaged!

scrollUp
    self scrollBy: 0@-1!

warpFactor
    ^1! !

!ScrollingInteractor methodsFor: 'event enquiry'!

interactorAt: aPoint

    | correction visibleOrigin |
    hScroller isNil ifFalse:
        [(hScroller containsPoint: aPoint) ifTrue:
            [^hScroller interactorAt: aPoint]].
    vScroller isNil ifFalse:
        [(vScroller containsPoint: aPoint) ifTrue:
            [^vScroller interactorAt: aPoint]].

    "*** I AM ABOUT TO ASSUME THAT SCROLLBARS ARE AT LEFT AND AT BOTTOM ***"

    correction := self scrollerCorrection.
    visibleOrigin := self origin + (correction x @ 0).
    ((visibleOrigin extent: self visibleExtent) containsPoint: aPoint)
        ifTrue: [^self component interactorAt: aPoint - visibleOrigin + self offset].
    ^nil! !

ScrollingInteractor subclass: #CachedScrollingInteractor
    instanceVariableNames: 'localPixmap rendered localGraphicsContext '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!CachedScrollingInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self rendered: false!

release
    self localPixmap release; close.
    super release! !

!CachedScrollingInteractor methodsFor: 'geometry'!

computeBounds: bounds

    | ve ce sc |
    self visibleExtent: (ve := bounds extent - (sc := self scrollerCorrection)).
    ce := self component minimumExtent.
    "(ve x < ce x or: [ve y < ce y]) ifTrue: [self uimsError]."
    self bounds: bounds.
    self component computeBounds: (0@0 extent:
            (self component hRigid ifTrue: [ce x] ifFalse: [ce x max: ve x]) @
            (self component vRigid ifTrue: [ce y] ifFalse: [ce y max: ve y])).
    self
        invalidateCachedCopy;
        offset: 0@0;
        setRanges;
        setBars.

    vScroller notNil ifTrue: [vScroller bounds: (bounds origin corner: 1@-1 * sc + bounds bottomLeft + (0@1))]. "ASSUMES V-SCROLLERS ON THE LEFT!!!!!!"

    hScroller notNil ifTrue: [hScroller bounds: (1@-1 * sc + bounds bottomLeft - (1@0) corner: bounds corner)].
    ^self bounds!

computeExtent

    | excess ext |
    ext := self component computeExtent.
    (self localPixmap isNil or: [(1@1 + ext <= self localPixmap extent) not])
        ifTrue: [self newPixmapExtent: 1@1 + ext].
    excess :=
        (self hScroller notNil ifTrue: [self hScroller minExtent] ifFalse: [Point zero]) +
        (self vScroller notNil ifTrue: [self vScroller minExtent] ifFalse: [Point zero]).
    ^(excess max: (self extent isNil
        ifTrue: [self preferredExtent: ext + self scrollerCorrection]
        ifFalse: [self extent])) max: 50@50! !

!CachedScrollingInteractor methodsFor: 'rendering'!

damaged
    self renderComponentOn: self parent graphicsContext.
    super damaged!

graphicsContext
    ^self localGraphicsContext!

graphicsContextFor: aComponent
    ^self localGraphicsContext!

reallyRenderComponentOn: gc

    gc
        clippingRectangle: ((self scrollerCorrection x @ 0 + self origin) extent: self visibleExtent);
        translateBy: self origin.
    self localPixmap
        displayOn: gc
        at: self offset negated + (self scrollerCorrection x @ 0).    "ASSUME H-SCROLLERS AT BOTTOM!!!!!!"
    gc
        translateBy: self origin negated;
        clippingRectangle: nil!

reallyRenderOn: gc

    self reallyRenderComponentOn: gc.

    vScroller notNil ifTrue: [vScroller renderOn: gc].
    hScroller notNil ifTrue: [hScroller renderOn: gc].

    self renderInactiveRegionOn: gc!

renderComponentOn: gc

    self rendered ifFalse: [self rendered: true; renderToCache].
    self reallyRenderComponentOn: gc!

renderOn: gc

    self rendered ifFalse: [self renderToCache; rendered: true].
    self reallyRenderOn: gc!

renderToCache

    self component renderOn: self localGraphicsContext! !

!CachedScrollingInteractor methodsFor: 'accessing'!

localGraphicsContext
    ^localGraphicsContext!

localGraphicsContext: gc
    localGraphicsContext := gc!

localPixmap
    ^localPixmap!

localPixmap: p
    localPixmap := p!

rendered
    ^rendered!

rendered: r
    rendered := r! !

!CachedScrollingInteractor methodsFor: 'private'!

clearLocalPixmap

    self localGraphicsContext medium
        background: self backgroundColor;
        clear!

invalidateCachedCopy

    | ext pext |
    ext := self visibleExtent max: self component extent.
    pext := self localPixmap extent.
    (ext x > pext x or: [ext y > pext y])
        ifTrue: [self newPixmapExtent: ext]
        ifFalse: [self clearLocalPixmap].
    self rendered: false!

newPixmapExtent: newExtent

    (self
        localPixmap: (Pixmap extent: newExtent);
        localGraphicsContext: (GraphicsContext on: self localPixmap);
        localGraphicsContext) font: FontDescription default.
    self clearLocalPixmap! !

LinearInteractor subclass: #TransparentInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!TransparentInteractor methodsFor: 'transparent behavior'!

activate
    ^self component activate!

deactivate
    ^self component deactivate!

deselect
    ^self component deselect!

newSelection: anInteractorOrNil
    ^parent newSelection: anInteractorOrNil!

offBlock
    ^self component offBlock!

offBlock: aBlock
    self component offBlock: aBlock!

onBlock
    ^self component onBlock!

onBlock: aBlock
    self component onBlock: aBlock!

radioGroup: aGroupie

    self component radioGroup: aGroupie!

select
    ^self component select! !

!TransparentInteractor methodsFor: 'transparent accessing'!

addChild: anInteractor

    self component isNil
        ifTrue: [self component: anInteractor]
        ifFalse: [self component addChild: anInteractor]!

component
    ^component!

parent
    ^parent!

transparentComponent
    ^component transparentComponent!

transparentParent
    ^parent transparentParent!

transparentSelf
    ^self component transparentSelf! !

!TransparentInteractor methodsFor: 'transparent geometry'!

computeBounds: bounds
    self bounds: bounds.
    ^self component computeBounds: bounds!

computeExtent

    ^self preferredExtent: self component computeExtent!

hElastic
    ^self component hElastic!

hElastic: x
    self component hElastic: x!

hRigid
    ^self component hRigid!

hRigid: x
    self component hRigid: x!

vElastic
    ^self component vElastic!

vElastic: x
    self component vElastic: x!

vRigid
    ^self component vRigid!

vRigid: x
    self component vRigid: x! !

TransparentInteractor subclass: #InsetInteractor
    instanceVariableNames: 'inset '
    classVariableNames: 'DefaultInset '
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!InsetInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self inset: self defaultInset! !

!InsetInteractor methodsFor: 'hierarchy'!

installHierarchy

    component
        parent: self;
        installHierarchy.!

installSensor: aSensor

    component installSensor: aSensor.
    super installSensor: aSensor!

installWindow: aWindow

    component installWindow: aWindow.
    super installWindow: aWindow! !

!InsetInteractor methodsFor: 'geometry'!

computeBounds: bounds

    self bounds: bounds.
    self component computeBounds: (bounds insetBy: self insetWidth).
    ^bounds!

computeExtent

    ^self preferredExtent: self component computeExtent + (self insetWidth * 2).! !

!InsetInteractor methodsFor: 'accessing'!

defaultInset
    ^DefaultInset!

inset
    "Overrides Interactor>>inset which wraps the receiver in an InsetInteractor
    with inset DefaultInset.  Thus multiple sends of inset add DefaultInset to the
    inset each time, but only ever cause at most a single InsetInteractor to created."

    self inset: self insetWidth + self defaultInset!

inset: i
    inset := i asInteger!

insetWidth
    ^inset! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

InsetInteractor class
    instanceVariableNames: ''!


!InsetInteractor class methodsFor: 'class initialization'!

initialize
    DefaultInset := 2! !

!InsetInteractor class methodsFor: 'instance creation'!

inset: i on: aComponent
    "This method now obsoleted by Interactor>>inset:"

    ^(self on: aComponent) inset: i! !

TransparentInteractor subclass: #BorderInteractor
    instanceVariableNames: 'foreground background selectionForeground selectionBackground borderWidth borderStyle '
    classVariableNames: 'DefaultBorderWidth '
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!BorderInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self borderWidth: self defaultBorderWidth.
    self borderStyle: #square!

inverseBorders
    | fg bg sfg sbg |
    fg := self foregroundColor.
    bg := self backgroundColor.
    sfg := self selectionForegroundColor.
    sbg := self selectionBackgroundColor.
    self
        foreground: sfg;
        background: sbg;
        selectionForeground: fg;
        selectionBackground: bg!

recessedBorders
    | fg bg sfg sbg |
    fg := self foregroundColor.
    bg := self backgroundColor.
    sfg := self selectionForegroundColor.
    sbg := self selectionBackgroundColor.
    self
        foreground: bg;
        background: fg;
        selectionForeground: sbg;
        selectionBackground: sfg!

staticBorders

    self
        selectionForegroundColor: self foregroundColor;
        selectionBackgroundColor: self backgroundColor! !

!BorderInteractor methodsFor: 'geometry'!

computeBounds: bounds

    self bounds: bounds.
    self component computeBounds: (self borderStyle == #round
        ifTrue: [(bounds insetBy: bounds extent // 4)]
        ifFalse: [bounds insetBy: self borderWidth]).
    ^bounds!

computeExtent

    ^self preferredExtent: (self borderStyle == #round
            ifTrue: [self component computeExtent * 2]
            ifFalse: [self component computeExtent + (self borderWidth * 2)])! !

!BorderInteractor methodsFor: 'accessing'!

background: b
    background := b!

bordered
    self borderWidth: self borderWidth + self defaultBorderWidth!

borderStyle
    ^borderStyle!

borderStyle: bs
    borderStyle := bs!

borderWidth
    ^"self isSquare ifTrue: ["borderWidth"] ifFalse: [(self radius / 2) asInteger]"!

borderWidth: bw
    borderWidth := bw asInteger!

defaultBorderWidth
    ^DefaultBorderWidth!

extent: aPoint
    super extent: aPoint.
    self component extent: aPoint - (self borderWidth * 2)!

foreground: f
    foreground := f!

radius
    ^(self bounds height min: self bounds width) // 2!

roundBorders
    self borderStyle: #round!

selectionBackground: b
    selectionBackground := b!

selectionForeground: b
    selectionForeground := b!

squareBorders
    self borderStyle: #square! !

!BorderInteractor methodsFor: 'testing'!

isRound
    ^self borderStyle == #round!

isSquare
    ^self borderStyle == #square! !

!BorderInteractor methodsFor: 'rendering'!

renderBorderForeground: fg background: bg exterior: ex interior: in on: aGC

    self borderStyle == #square
        ifTrue: [self renderSquareBorderForeground: fg background: bg exterior: ex interior: in on: aGC]
        ifFalse: [    self borderStyle == #round
            ifTrue: [self renderRoundBorderForeground: fg background: bg exterior: ex interior: in on: aGC]
            ifFalse: [self error: 'buggered border, buddy - dunno how to draw "' , self borderStyle printString , '" borders!!']]!

renderDeselectedOn: aGC

    self
        renderBorderForeground: self foregroundColor
        background: self backgroundColor
        exterior: super backgroundColor
        interior: super backgroundColor
        on: aGC!

renderRoundBorderForeground: fg background: bg exterior: ex interior: in on: aGC

    | cbox bbox radius arcbox translation inset topLeft bottomRight |
    bbox := self bounds.
    cbox := self component bounds.
    radius := (cbox center y - bbox top min: cbox center x - bbox left) * 2.
    inset := radius / 2.
    arcbox := Point zero extent: radius.
    translation := 0@(bbox height - arcbox height / 2).
    topLeft := bbox origin + translation.
    bottomRight := bbox corner - translation.
    aGC
        lineWidth: self borderWidth;
        paint: ex;
        displayRectangle: bbox;
        paint: in;
        displayWedgeBoundedBy: arcbox startAngle: 90 sweepAngle: 180 at: topLeft;
        displayWedgeBoundedBy: arcbox startAngle: 270 sweepAngle: 180 at: bottomRight - radius;
        displayRectangle: (topLeft + (inset@0) corner: bottomRight - (inset@0));
        paint: bg;
        displayArcBoundedBy: arcbox startAngle: 135 sweepAngle: 135 at: topLeft;
        displayArcBoundedBy: arcbox startAngle: 270 sweepAngle: 45 at: bottomRight - radius;
        displayLineFrom: topLeft + (inset@0) to: bottomRight - radius + (inset@0);
        paint: fg;
        displayArcBoundedBy: arcbox startAngle: 315 sweepAngle: 135 at: bottomRight - radius;
        displayArcBoundedBy: arcbox startAngle: 90 sweepAngle: 45 at: topLeft;
        displayLineFrom: topLeft + radius - (inset@0) to: bottomRight - (inset@0)!

renderSelectedOn: aGC

    self
        renderBorderForeground: self selectionForegroundColor
        background: self selectionBackgroundColor
        exterior: super backgroundColor
        interior: super selectionBackgroundColor
        on: aGC!

renderSquareBorderForeground: fg background: bg exterior: ex interior: in on: aGC

    | bbox |
    bbox := self borderBounds.
    self borderWidth timesRepeat:
        [aGC
            paint: fg;
            displayPolyline: (OrderedCollection with: bbox bottomLeft with: bbox bottomRight with: bbox topRight);
            paint: bg;
            displayPolyline: (OrderedCollection with: bbox bottomLeft with: bbox topLeft with: bbox topRight).
        bbox origin: bbox origin + 1.
        bbox corner: bbox corner - 1]! !

!BorderInteractor methodsFor: 'coloring'!

backgroundColor

    ^background isNil ifTrue: [^super borderBackgroundColor] ifFalse: [^background]!

foregroundColor

    ^foreground isNil ifTrue: [^super borderForegroundColor] ifFalse: [^foreground]!

selectionBackgroundColor

    ^selectionBackground isNil ifTrue: [^super borderForegroundColor] ifFalse: [^selectionBackground]!

selectionForegroundColor

    ^selectionForeground isNil ifTrue: [^super borderBackgroundColor] ifFalse: [^selectionForeground]! !

!BorderInteractor methodsFor: 'event response'!

componentDeselected

    self selected: false; renderOn: self graphicsContext!

componentSelected

    self selected: true; renderOn: self graphicsContext! !

!BorderInteractor methodsFor: 'transparent geometry'!

minumumExtent: aPoint

    self component minimumExtent: aPoint - (self borderWidth * 2).
    super minimumExtent: aPoint! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BorderInteractor class
    instanceVariableNames: ''!


!BorderInteractor class methodsFor: 'class initialization'!

initialize
    DefaultBorderWidth := 2! !

!BorderInteractor class methodsFor: 'instance creation'!

inverseOn: aComponent
    ^self on: aComponent; inverseBorders! !

TransparentInteractor subclass: #ActiveInteractor
    instanceVariableNames: 'onBlock offBlock radioGroup justification isToggle isCyclic isRepeating repeatPause repeatDelay '
    classVariableNames: 'RepeatDelay RepeatPause '
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!ActiveInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self
        isToggle: false;
        isCyclic: false;
        isRepeating: false;
        repeatPause: self defaultRepeatPause;
        repeatDelay: self defaultRepeatDelay!

release
    self
        onBlock: nil;
        offBlock: nil;
        radioGroup: nil.
    super release! !

!ActiveInteractor methodsFor: 'accessing'!

addChild: aThing
    self component: aThing!

defaultRepeatDelay
    ^RepeatDelay!

defaultRepeatPause
    ^RepeatPause!

isCyclic
    ^isCyclic!

isCyclic: flag
    isCyclic := flag!

isRepeating
    ^isRepeating!

isRepeating: aBool
    isRepeating := aBool!

isToggle
    ^isToggle!

isToggle: t
    isToggle := t!

offBlock
    ^offBlock!

offBlock: aBlock

    offBlock := aBlock!

onBlock
    ^onBlock!

onBlock: aBlock

    onBlock := aBlock!

radioGroup
    ^radioGroup!

radioGroup: rg
    radioGroup := rg!

repeatDelay
    ^repeatDelay!

repeatDelay: anInteger
    repeatDelay := anInteger!

repeatPause
    ^repeatPause!

repeatPause: anInteger
    repeatPause := anInteger! !

!ActiveInteractor methodsFor: 'event enquiry'!

interactorAt: aPoint
    ^(self bounds containsPoint: aPoint) ifTrue: [self]! !

!ActiveInteractor methodsFor: 'event response'!

activate
    self onBlock value: self!

deactivate
    self offBlock notNil ifTrue: [self offBlock value: self]!

deselect
    self selected: false.
    self render!

select
    (self
        selected: true;
        renderOn: self graphicsContext;
        parent) componentSelected!

selectDown

    self selected isNil ifTrue: [self selected: false].
    (self selected and: [self isCyclic not])
        ifTrue:
            [(self
                selected: false;
                render; damaged;
                offBlock) notNil ifTrue: [self offBlock value: self].
            self sensor waitNoButton]
        ifFalse:
            [self isRadioButton ifTrue: [self radioGroup newSelection: self].
            (self
                selected: true;
                render; damaged;
                onBlock) notNil ifTrue: [self onBlock value: self].
            self isRepeating
                ifTrue:
                    [ | ms |
                    ms := Time millisecondClockValue.
                    [self selectButtonPressed and: [Time millisecondClockValue - ms < self repeatPause]] whileTrue.
                    [self selectButtonPressed]
                        whileTrue:
                            [(self
                                selected: false;
                                render;
                                damaged;
                                offBlock) notNil ifTrue: [self onBlock value: self].
                            (self
                                selected: true;
                                render; damaged;
                                onBlock) notNil ifTrue: [self onBlock value: self].
                            (Delay forMilliseconds: self repeatDelay) wait]]
                ifFalse: [self sensor waitNoButton].
            (self isToggle or: [self isCyclic])
                ifFalse:
                    [self selected: false.
                    self render; damaged.
                    self offBlock notNil ifTrue: [self offBlock value: self]].]! !

!ActiveInteractor methodsFor: 'controling'!

autoRepeat
    self isRepeating: true!

cyclic
    self isCyclic: true!

toggle
    self isToggle: true! !

!ActiveInteractor methodsFor: 'testing'!

isRadioButton
    ^self radioGroup notNil! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ActiveInteractor class
    instanceVariableNames: ''!


!ActiveInteractor class methodsFor: 'class initialization'!

initialize
    RepeatPause := 500.
    RepeatDelay := 50! !

StemInteractor subclass: #ManifoldInteractor
    instanceVariableNames: 'children '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!ManifoldInteractor methodsFor: 'initialize-release'!

release
    self children notNil ifTrue: [self children do: [ :sprog | sprog release]].
    self children: nil! !

!ManifoldInteractor methodsFor: 'hierarchy'!

installComposites
    self children do: [ :sprog | sprog installComposites]!

installHierarchy

    self children do: [ :sprog | sprog parent: self; installHierarchy]!

installSensor: aSensor

    self children do: [ :sprog | sprog installSensor: aSensor].
    super installSensor: aSensor!

installWindow: aWindow

    self children do: [ :sprog | sprog installWindow: aWindow].
    super installWindow: aWindow! !

!ManifoldInteractor methodsFor: 'accessing'!

addChild: aChild
    self children addLast: aChild!

children
    ^children!

children: brats
    children := brats!

moveChild: after toBeJustAfter: before
    children remove: after.
    children add: after after: before!

selected: flag
    children do: [ :brat | brat selected: flag].
    super selected: flag! !

!ManifoldInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i

    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo.
    children do: [ :sprog | sprog printHierarchyOn: aStream indent: i+1]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ManifoldInteractor class
    instanceVariableNames: ''!


!ManifoldInteractor class methodsFor: 'instance creation'!

addChild: aComponent
    ^self new addChild: aComponent! !

ManifoldInteractor subclass: #VirtualInteractor
    instanceVariableNames: 'activeChild '
    classVariableNames: 'ShamDisplaySurface '
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!VirtualInteractor methodsFor: 'geometry'!

computeBounds: bBox

    self bounds: bBox.
    self children do: [ :sprog | sprog computeBounds: bBox].
    ^self bounds!

computeExtent

    | width height |
    width := self extent x.
    height := self extent y.
    self children do: [ :sprog || ext |
        ext := sprog computeExtent.
        ext x > width ifTrue: [width := ext x].
        ext y > height ifTrue: [height := ext y]].
    ^self preferredExtent: width@height! !

!VirtualInteractor methodsFor: 'accessing'!

activeChild
    ^activeChild!

activeChild: brat
    activeChild := brat.
    brat notNil ifTrue: [brat parent: self; installHierarchy]!

addChild: anInteractor

    super addChild: anInteractor.
    self activeChild: anInteractor! !

!VirtualInteractor methodsFor: 'rendering'!

graphicsContextFor: anInteractor

    ^(anInteractor hasIndirectParent: self activeChild)
        ifTrue: [super graphicsContextFor: anInteractor]
        ifFalse: [GraphicsContext on: ShamDisplaySurface].
    "^super graphicsContextFor: anInteractor"!

renderOn: aGC

    super renderOn: aGC.
    self activeChild isNil
        ifFalse: [self activeChild renderOn: aGC]! !

!VirtualInteractor methodsFor: 'controlling'!

useComponentIndex: index

    self children size < index ifTrue: [self error: 'no such component in VirtualInteractor'].
    (self activeChild: (self children asArray at: index)) render!

useComponentNext

    | index |
    index := self children indexOf: self activeChild.
    index == self children size ifTrue: [index := 0].
    index := index + 1.
    (self activeChild: (self children asArray at: index)) render.
    ^self activeChild! !

!VirtualInteractor methodsFor: 'event enquiry'!

interactorAt: aPoint

    self activeChild isNil
        ifTrue: [^nil]
        ifFalse: [^self activeChild interactorAt: aPoint]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

VirtualInteractor class
    instanceVariableNames: ''!


!VirtualInteractor class methodsFor: 'class initialization'!

initialize

    ShamDisplaySurface := Pixmap extent: 0@0! !

!VirtualInteractor class methodsFor: 'instance creation'!

new
    ^super new children: OrderedCollection new! !

ManifoldInteractor subclass: #GraphInteractor
    instanceVariableNames: 'actionBlocks activeRegions '
    classVariableNames: 'ActiveRegionSize AxisLabelOffset AxisResolution BottomSpace LeftSpace RightSpace TopSpace '
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!GraphInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    children := OrderedCollection new.
    actionBlocks := IdentityDictionary new.
    activeRegions := IdentityDictionary new! !

!GraphInteractor methodsFor: 'hierarchy'!

installComposites
    "override the one above that assumes children are interactors"!

installHierarchy!

installSensor: w
    "override the one above that assumes children are interactors"!

installWindow
    "override the one above that assumes children are interactors"!

installWindow: w
    "override the one above that assumes children are interactors"! !

!GraphInteractor methodsFor: 'geometry'!

computeBounds: bounds
    | maxVal minVal deltaVal verticalRange verticalScale deltaX baseLine abscissa |
    self bounds: bounds.
    maxVal := self maxVal.
    minVal := self minVal.
    deltaVal := maxVal - minVal.
    verticalRange := bounds height - self topSpace - self bottomSpace.
    verticalScale := verticalRange / deltaVal.
    deltaX := ((bounds width - self leftSpace - self rightSpace) / self children size).
    baseLine := bounds bottom - self bottomSpace.
    abscissa := bounds left + self leftSpace + (deltaX / 2).
    children do: [ :brat |
        self activeRegions at: brat put: (self activeRegionAt: abscissa@(baseLine - (brat value - minVal * verticalScale))).
        abscissa := abscissa + deltaX].
    ^bounds!

computeExtent
    ^self preferredExtent: 300@200! !

!GraphInteractor methodsFor: 'accessing'!

actionBlocks
    ^actionBlocks!

activeRegions
    ^activeRegions!

addChild: aValue
    children add: (IdentityWrapper on: aValue)!

addChild: aValue actionBlock: aBlockOrNil
    | id |
    self children add: (id := IdentityWrapper on: aValue).
    actionBlocks at: id put: aBlockOrNil.
    activeRegions at: id put: nil!

addChildren: bratList

    self children addAll: bratList!

children
    ^children!

children: c
    children := c! !

!GraphInteractor methodsFor: 'rendering'!

obsoleteRenderOn: aGC

    self
        renderBackgroundOn: aGC;
        renderCircularOn: aGC;        "use renderCircularOn: or renderRectangularOn: as appropriate!!"
        renderAxesOn: aGC!

renderAxesOn: aGC

    | vStep minVal floor ceiling vScale left right |
    vStep := self maxVal - (minVal := self minVal) / self axisResolution.
    floor := self bounds bottom - self bottomSpace.
    ceiling := self bounds top + self topSpace.
    vScale := floor - ceiling / self axisResolution.
    left := self bounds left + self leftSpace.
    right := self bounds right - self rightSpace.
    0 to: self axisResolution do: [ :yIndex || text |
        text := (yIndex * vStep + minVal) asInteger printString asComposedText.
         aGC
            displayLineFrom: left@(floor - (yIndex * vScale))
                to: right@(floor - (yIndex * vScale));
            displayString: text asString
                at: (left - text width - self axisLabelOffset)@(text height / 3 + floor - (yIndex * vScale))]!

renderCircularOn: aGC

    | vertices |
    vertices := (self children collect: [ :brat | aGC
        paint: self foregroundColor;
        displayWedgeBoundedBy: ((self activeRegions at: brat) insetBy: -1)
            startAngle: 0
            sweepAngle: 360;
        paint: self backgroundColor;
        displayWedgeBoundedBy: ((self activeRegions at: brat) insetBy: 1)
            startAngle: 0
            sweepAngle: 360.
        (self activeRegions at: brat) center]).
    aGC
        paint: self foregroundColor;
        displayPolyline: vertices!

renderRectangularOn: aGC

    | vertices |
    vertices := (self children collect: [ :brat | aGC
        paint: self foregroundColor;
        displayRectangle: (self activeRegions at: brat);
        paint: self backgroundColor;
        displayRectangle: ((self activeRegions at: brat) insetBy: 2).
        (self activeRegions at: brat) center]).
    aGC
        paint: self foregroundColor;
        displayPolyline: vertices! !

!GraphInteractor methodsFor: 'event response'!

selectDown

    | hotSpot activeBrat |
    hotSpot := self sensor cursorPoint.
    activeBrat := self children detect: [ :brat | (activeRegions at: brat) containsPoint: hotSpot] ifNone: [].
    activeBrat notNil ifTrue: [(actionBlocks at: activeBrat) value: activeBrat value]! !

!GraphInteractor methodsFor: 'constants'!

activeRegionSize
    ^ActiveRegionSize!

axisLabelOffset
    ^AxisLabelOffset!

axisResolution
    ^AxisResolution!

bottomSpace
    ^BottomSpace!

leftSpace
    ^LeftSpace!

rightSpace
    ^RightSpace!

topSpace
    ^TopSpace! !

!GraphInteractor methodsFor: 'private'!

activeRegionAt: aPoint
    ^(aPoint extent: self activeRegionSize asPoint) translatedBy: (self activeRegionSize / 2) negated!

maxVal
    ^self children inject: self children first value into: [ :max :brat | max max: brat value]!

minVal
    ^self children inject: self children first value into: [ :min :brat | min min: brat value]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GraphInteractor class
    instanceVariableNames: ''!


!GraphInteractor class methodsFor: 'class initialization'!

initialize
    self
        topSpace: 15;
        bottomSpace: 15;
        leftSpace: 30;
        rightSpace: 15;
        activeRegionSize: 9;
        axisResolution: 4;        "the number of y axis marks above the baseline"
        axisLabelOffset: 2        "the number of pixels to the left of the y axis marks to display the labels"! !

!GraphInteractor class methodsFor: 'accessing'!

activeRegionSize: anInteger
    ActiveRegionSize := anInteger!

axisLabelOffset: anInteger
    AxisLabelOffset := anInteger!

axisResolution: anInteger
    AxisResolution := anInteger!

bottomSpace: indent
    BottomSpace := indent!

leftSpace: indent
    LeftSpace := indent!

rightSpace: indent
    RightSpace := indent!

topSpace: indent
    TopSpace := indent! !

ManifoldInteractor subclass: #CompositeInteractor
    instanceVariableNames: 'isRadioGroup currentSelection '
    classVariableNames: 'FlattenPolicy '
    poolDictionaries: ''
    category: 'Interactors-Framework'!
CompositeInteractor comment:
'children            (Set of Representation) representations which are part of me
'!


!CompositeInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    self children: OrderedCollection new.
    self isRadioGroup: false!

initializeFrom: aComposite
    self
        isRadioGroup: aComposite isRadioGroup;
        currentSelection: aComposite currentSelection;
        children: aComposite children!

release
    children notNil ifTrue: [children do: [ :sprog | sprog release]].
    children := currentSelection := nil.
    super release! !

!CompositeInteractor methodsFor: 'hierarchy'!

assimilateChild: brat
    "brat is another composite"

    brat do: [ :bratlet | self add: bratlet after: brat].
    self remove: brat!

cloakChild: brat
    | index |
    index := self children indexOf: brat.
    self children at: index put: ((self children at: index) inset: 0)!

installComposites

    "This is a HORRENDOUS kludge to cope with pjc's interfaces.  His tortured interface
    generation stuff sometimes puts composites inside another composite which adds
    children in the same dimension (e.g. an AlignedRow inside another AlignedRow).

    This completely fucks the geometry calculations done by DynamicComposites, and
    should NOT be considered acceptable behavior for any interface generator.

    Two solutions are possible: either the incestuous children get wrapped in a cloaking
    device (such as an inset interactor with inset 0) or they become assimilated into
    the parent.  The policy used is determined by the class variable FlattenPolicy which
    can be #cloak (invisible inset) or #borg (assimilate into the whole).  The former trades
    an increase in space for time, the latter a decrease in space for time.  It is not yet
    clear whether these two policies ever produce different visual results.

    This gets propagated down the hierarchy BEFORE the RootInteractor kicks any
    geometry negotiations into motion."

    self children do: [ :sprog |
        (sprog isComposite and: [sprog dimension == self dimension])
            ifTrue: [self flattenPolicy == #cloak
                ifTrue: [self cloakChild: sprog]
                ifFalse: [self flattenPolicy == #borg
                    ifTrue: [^self assimilateChild:sprog; installComposites]
                    ifFalse: [self flattenPolicy == #none
                        ifTrue: [^self]
                        ifFalse: [self error: 'Rotten FlattenPolicy in CompositeInteractor!!']]]]].
    super installComposites.
    ((self children detect: [ :sprog | sprog isAlignedComposite] ifNone: []) notNil and: [self isDynamicComposite not])
        ifTrue: [self become: self asDynamicComposite]! !

!CompositeInteractor methodsFor: 'accessing'!

addChild: aChild
    super addChild: aChild.
    self isRadioGroup ifTrue: [aChild radioGroup: self]!

addChild: aChild at: aPosition

    "aPosition is either:
        #first        - prepend
        #last        - append
        anInteger    - absolute position:
            1    - first
            2    - second
            -1    - last
            -2    - next to last
    and so on..."

    | position |
    self isRadioGroup ifTrue: [aChild radioGroup: self].
    aPosition == #first ifTrue: [^self children addFirst: aChild].
    aPosition == #last ifTrue: [^self children addLast: aChild].
    (aPosition == 0 or: [self children size < aPosition abs]) ifTrue: [self uimsError].
    position := aPosition < 0
        ifTrue: [self children size + aPosition + 2]
        ifFalse: [aPosition].
    self addChild: aChild atIndex: aPosition.!

addChild: aChild atIndex: aPosition

    self isRadioGroup ifTrue: [aChild radioGroup: self].
    (aPosition == #first or: [aPosition == 0]) ifTrue: [^self children addFirst: aChild].
    aPosition == #last ifTrue: [^self children addLast: aChild].
    (aPosition == 0 or: [self children size < aPosition abs]) ifTrue: [self uimsError].
    self children add: aChild beforeIndex: (aPosition < 0
        ifTrue: [self children size + aPosition + 2]
        ifFalse: [aPosition])!

addChild: aChild beforeClass: aClass

    "add aChild before first instance of aClass (or a subclass thereof), otherwise at end"

    | target |
    target := self children detect: [ :sprog | sprog isMemberOf: aClass] ifNone: [].
    target isNil ifTrue: [^self children addLast: aChild].
    self children add: aChild before: target.
    self isRadioGroup ifTrue: [aChild radioGroup: self]!

beRadioGroup
    self isRadioGroup: true.
    self children do: [ :sprog | sprog radioGroup: self].
    self children do: [ :sprog | sprog selected ifTrue: [self currentSelection: sprog]]!

currentSelection
    ^currentSelection!

currentSelection: anInteractor
    currentSelection := anInteractor!

flattenPolicy
    ^FlattenPolicy!

installChild: aChild
    aChild computeExtent.
    self children addLast: aChild.
    self isRadioGroup ifTrue: [aChild radioGroup: self].
    aChild
        parent: self;
        installHierarchy;
        installSensor: self sensor;
        installWindow: self window.
    self computeBounds: self bounds.
    self renderOn: self graphicsContext!

isRadioGroup
    ^isRadioGroup!

isRadioGroup: flag
    isRadioGroup := flag!

radioGroup: aComposite
    self children do: [ :sprog | sprog radioGroup: aComposite]!

uninstallLastChild
    self children removeLast.
    self computeBounds: self bounds.
    self renderOn: self graphicsContext!

window: aWindow
    super window: aWindow.
    children do: [ :brat | brat window: aWindow]! !

!CompositeInteractor methodsFor: 'rendering'!

renderForegroundOn: gc
    self children isEmpty
        ifFalse: [self children do: [ :child | child renderOn: gc]]! !

!CompositeInteractor methodsFor: 'event enquiry'!

interactorAt: aPoint

    children do: [ :sprog |
        (sprog containsPoint: aPoint)
            ifTrue: [^sprog interactorAt: aPoint]].
    ^nil! !

!CompositeInteractor methodsFor: 'event response'!

newSelection: aChild

    (self currentSelection ~~ aChild and: [self currentSelection notNil])
        ifTrue:
            [self currentSelection
                deactivate;
                deselect.
            self damaged.].
    self currentSelection: aChild! !

!CompositeInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i

    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo.
    children do: [ :sprog | sprog printHierarchyOn: aStream indent: i+1]! !

!CompositeInteractor methodsFor: 'testing'!

isComposite
    ^true! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

CompositeInteractor class
    instanceVariableNames: ''!


!CompositeInteractor class methodsFor: 'class initialization'!

initialize
    FlattenPolicy := #none! !

CompositeInteractor subclass: #ColumnInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!ColumnInteractor methodsFor: 'geometry'!

computeBounds: bounds

    | currentOrigin elasticChildren lastElasticChild totalRigidHeight totalElasticHeight totalPreferredHeight spareHeight remainingSpareHeight |

    self bounds: bounds.
    elasticChildren := 0.
    self children size == 0 ifTrue: [^bounds].
    totalRigidHeight := totalElasticHeight := totalPreferredHeight := 0.
    children do: [ :child |
        child vRigid
            ifTrue: [totalRigidHeight := totalRigidHeight + child preferredHeight]
            ifFalse:
                [totalElasticHeight := totalElasticHeight + child preferredHeight.
                elasticChildren := elasticChildren + 1.
                lastElasticChild := child]].

    totalPreferredHeight := totalElasticHeight + totalRigidHeight.
    (spareHeight := remainingSpareHeight := bounds height - totalPreferredHeight) < 0 ifTrue: [self uimsError].
    currentOrigin := bounds origin.

    children do: [ :child || cw ch |
        cw := child hRigid
                ifTrue: [child preferredWidth]
                ifFalse: [bounds width].
        child vRigid
            ifTrue: [ch := child preferredHeight]
            ifFalse: [child == lastElasticChild
                        ifTrue: [ch := child preferredHeight + remainingSpareHeight]
                        ifFalse: [
                            ch := (spareHeight * child preferredHeight / totalElasticHeight) asInteger.
                            remainingSpareHeight := remainingSpareHeight - ch.
                            ch := ch + child preferredHeight]].
        child computeBounds: (currentOrigin extent: cw@ch).
        currentOrigin := currentOrigin + (0@ch)].

    ^bounds!

computeExtent

    | width height |
    self hRigid: true.
    width := self extent x.
    height := 0.
    children do: [ :child || pb |
        pb := child computeExtent.
        height := height + pb y.
        pb x > width ifTrue: [width := pb x].
        self hRigid: (self hRigid and: [child hRigid])].
    ^self preferredExtent: width@height! !

!ColumnInteractor methodsFor: 'testing'!

dimension
    ^#vertical! !

!ColumnInteractor methodsFor: 'converting'!

asDynamicComposite
    ^DynamicColumnInteractor new initializeFrom: self! !

ColumnInteractor subclass: #DynamicColumnInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!DynamicColumnInteractor methodsFor: 'geometry'!

computeExtent
    "Dynamically allocate field widths to children to line them up in rows or columns.
    If my children aren't all AlignedComposites then I'm buggered.

    This is only guaranteed to work if children have the same arity.  However,
    it won't break if this assumption is invalid - it'll just look real ugly."

    | width height leeways |
    leeways := Array
        new: (self children inject: 0 into: [ :max :brat | (brat isComposite ifTrue: [brat children size] ifFalse: [0]) max: max])
        withAll: 0.
    leeways size = 0 ifTrue: [^super computeExtent].
    self children do: [ :sprog |
        sprog isComposite
            ifTrue: [ | index |
                index := 1.
                sprog children do: [ :sproglet |
                    leeways at: index put: ((leeways at: index) max: sproglet computeExtent x).
                    index := index + 1]]].
    self children do: [ :sprog |
        sprog isAlignedComposite
            ifTrue: [| index |
                index := 0.
                sprog children do: [ :sproglet | sprog allocations at: sproglet put: (leeways at: (index := 1 + index))]]].
    self hRigid: true.
    width := height := 0.
    width := children inject: 0 into: [ :w :x | w max: (x computeExtent; preferredWidth)].
    children do: [ :child || box |
        height := height + (box := child computeExtent) y.
        self hRigid: (self hRigid and: [child hRigid])."
        child extent: width@box y.
        child isAlignedComposite
            ifTrue: [ | index |
                index := 0.
                child children do: [ :sprog | sprog extent: width@(leeways at: (index := index + 1))]]"].
    (width = 0 or: [height = 0]) ifTrue: [self uimsError].
    ^self preferredExtent: width@height! !

!DynamicColumnInteractor methodsFor: 'testing'!

dimension
    ^#vertical!

isDynamicComposite
    ^true! !

CompositeInteractor subclass: #AlignedCompositeInteractor
    instanceVariableNames: 'allocations '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!AlignedCompositeInteractor methodsFor: 'initialize-release'!

initialize
    super initialize.
    allocations := IdentityDictionary new! !

!AlignedCompositeInteractor methodsFor: 'hierarchy'!

assimilateChild: brat
    "brat is another composite"

    brat children do: [ :bratlet | self children add: bratlet after: brat].
    brat isAlignedComposite ifTrue: [self allocations addAll: brat allocations associations].
    self children remove: brat.
    self allocations removeKey: brat!

cloakChild: old
    | new |
    new := old inset: 0.
    self children at: (self children indexOf: old) put: new.
    self allocations
        at: new put: (self allocations at: old);
        removeKey: old! !

!AlignedCompositeInteractor methodsFor: 'accessing'!

addChild: anInteractor
    ^self addChild: anInteractor allocation: 1!

addChild: anInteractor allocation: anAllocation
    super addChild: anInteractor.
    self allocations at: anInteractor put: anAllocation!

addChild: anInteractor at: aPosition
    ^self addChild: anInteractor at: aPosition allocation: 1!

addChild: anInteractor at: aPosition allocation: anAllocation

    super addChild: anInteractor at: aPosition.
    self allocations at: anInteractor put: anAllocation!

addChild: anInteractor atIndex: anIndex
    ^self addChild: anInteractor atIndex: anIndex allocation: 1!

addChild: anInteractor atIndex: anIndex allocation: anAllocation

    super addChild: anInteractor atIndex: anIndex.
    self allocations at: anInteractor put: anAllocation!

addChild: aChild beforeClass: aClass

    ^self addChild: aChild beforeClass: aClass allocation: 1!

addChild: anInteractor beforeClass: aClass allocation: anAllocation

    super addChild: anInteractor beforeClass: aClass.
    self allocations at: anInteractor put: anAllocation!

allocations
    ^allocations!

installChild: aChild

    ^self error: 'not yet implemented - request assistance'!

moveChild: after toBeJustAfter: before
    ^self error: 'not yet implemented - request assistance!!'!

totalAllocation

    ^self allocations values inject: 0 into: [ :total :allocation | allocation + total]! !

!AlignedCompositeInteractor methodsFor: 'testing'!

isAlignedComposite
    ^true! !

AlignedCompositeInteractor subclass: #AlignedColumnInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!AlignedColumnInteractor methodsFor: 'geometry'!

computeBounds: bounds

    | currentOrigin totalAllocation totalHeight sprogWidth |
    totalHeight := (self bounds: bounds) height.
    sprogWidth := bounds width.
    totalAllocation := self totalAllocation.
    currentOrigin := self origin.
    self children do: [ :sprog || sprogHeight |
        sprog == self children last
            ifTrue:
                [sprog computeBounds: (currentOrigin corner: self bounds corner)]
            ifFalse:
                [sprogHeight := ((self allocations at: sprog) / totalAllocation * totalHeight) asInteger.
                sprogHeight < sprog minimumExtent y ifTrue: [self uimsError].
                sprog computeBounds: (currentOrigin extent: sprogWidth@sprogHeight).
                currentOrigin := currentOrigin + (0@sprogHeight)]].
    ^bounds!

computeExtent

    | width height totalAllocation |

    totalAllocation := self totalAllocation.
    self hRigid: true.
    width := height := 0.
    children do: [ :sprog || pb |
        pb := sprog computeExtent.
        height := height max: (totalAllocation / (allocations at: sprog) * pb y) asInteger + 1.
        width := pb x max: width.
        self hRigid: (self hRigid and: [sprog hRigid])].
    ^self preferredExtent: width@height!

computeMinimumExtent
    "Calculate my minimum extent, ignoring allocations"

    | width height |
    self hRigid: true.
    width := height := 0.
    children do: [ :sprog || pb |
        pb := sprog computeExtent.
        height := height + pb y.
        width := pb x max: width.
        self hRigid: (self hRigid and: [sprog hRigid])].
    ^self preferredExtent: width@height! !

!AlignedColumnInteractor methodsFor: 'testing'!

dimension
    ^#vertical! !

AlignedCompositeInteractor subclass: #AlignedRowInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!AlignedRowInteractor methodsFor: 'geometry'!

computeBounds: bounds

    | currentOrigin totalAllocation totalWidth sprogHeight |
    totalWidth := (self bounds: bounds) width.
    sprogHeight := bounds height.
    totalAllocation := self totalAllocation.
    currentOrigin := self origin.
    self children do: [ :sprog || sprogWidth |
        sprog == self children last
            ifTrue:
                [sprog computeBounds: (currentOrigin corner: self bounds corner)]
            ifFalse:
                [sprogWidth := ((self allocations at: sprog) / totalAllocation * totalWidth) asInteger.
                sprogWidth < sprog minimumExtent x ifTrue: [self uimsError].
                sprog computeBounds: (currentOrigin extent: sprogWidth@sprogHeight).
                currentOrigin := currentOrigin + (sprogWidth@0)]].
    ^bounds!

computeExtent

    | width height totalAllocation |
    totalAllocation := self totalAllocation.
    self vRigid: true.
    width := height := 0.
    children do: [ :sprog || pb |
        pb := sprog computeExtent.
        width := width max: (totalAllocation / (allocations at: sprog) * pb x) asInteger + 1.
        height := pb y max: height.
        self vRigid: (self vRigid and: [sprog vRigid])].
    ^self preferredExtent: width@height!

computeMinimumExtent
    "Calculate my minimum extent, ignoring allocations"

    | width height |
    self vRigid: true.
    width := height := 0.
    children do: [ :sprog || pb |
        pb := sprog computeExtent.
        width := width + pb x.
        height := pb y max: height.
        self vRigid: (self vRigid and: [sprog vRigid])].
    ^self preferredExtent: width@height! !

!AlignedRowInteractor methodsFor: 'testing'!

dimension
    ^#horizontal! !

CompositeInteractor subclass: #RowInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!RowInteractor methodsFor: 'geometry'!

computeBounds: bounds

    | currentOrigin elasticChildren lastElasticChild totalRigidWidth totalElasticWidth totalPreferredWidth spareWidth remainingSpareWidth |

    self bounds: bounds.
    elasticChildren := 0.
    self children size == 0 ifTrue: [^bounds].
    totalRigidWidth := totalElasticWidth := totalPreferredWidth := 0.
    children do: [ :child |
        child hRigid
            ifTrue: [totalRigidWidth := totalRigidWidth + child preferredWidth]
            ifFalse:
                [totalElasticWidth := totalElasticWidth + child preferredWidth.
                elasticChildren := elasticChildren + 1.
                lastElasticChild := child]].

    totalPreferredWidth := totalElasticWidth + totalRigidWidth.
    (spareWidth := remainingSpareWidth := bounds width - totalPreferredWidth) < 0 ifTrue: [self uimsError].
    currentOrigin := bounds origin.

    children do: [ :child || cw ch |
        ch := child vRigid
                ifTrue: [child preferredHeight]
                ifFalse: [bounds height].
        child hRigid
            ifTrue: [cw := child preferredWidth]
            ifFalse: [child == lastElasticChild
                        ifTrue: [cw := child preferredWidth + remainingSpareWidth]
                        ifFalse: [
                            cw := (spareWidth * child preferredWidth / totalElasticWidth) asInteger.
                            remainingSpareWidth := remainingSpareWidth - cw.
                            cw := cw + child preferredWidth]].
        child computeBounds: (currentOrigin extent: cw@ch).
        currentOrigin := currentOrigin + (cw@0)].

    ^bounds!

computeExtent

    | width height |
    self vRigid: true.
    width := 0.
    height := self extent y.
    children do: [ :child || pb |
        pb := child computeExtent.
        width := width + pb x.
        pb y > height ifTrue: [height := pb y].
        self vRigid: (self vRigid and: [child vRigid])].
    ^self preferredExtent: width@height! !

!RowInteractor methodsFor: 'testing'!

dimension
    ^#horizontal! !

!RowInteractor methodsFor: 'converting'!

asDynamicComposite
    ^DynamicRowInteractor new initializeFrom: self! !

RowInteractor subclass: #DynamicRowInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!DynamicRowInteractor methodsFor: 'geometry'!

computeExtent
    "Dynamically allocate field widths to children to line them up in rows or columns.
    If my children aren't all AlignedComposites then I'm buggered.

    This is only guaranteed to work if children have the same arity.  However,
    it won't break if this assumption is invalid - it'll just look real ugly."

    | width height leeways |
    leeways := Array
        new: (self children inject: 0 into: [ :max :brat | (brat isComposite ifTrue: [brat children size] ifFalse: [0]) max: max])
        withAll: 0.
    self children do: [ :sprog |
        sprog isComposite
            ifTrue: [ | index |
                index := 1.
                sprog children do: [ :sproglet |
                    leeways at: index put: ((leeways at: index) max: sproglet computeExtent y).
                    index := index + 1]]].
    self children do: [ :sprog |
        sprog isAlignedComposite
            ifTrue: [| index |
                index := 0.
                sprog children do: [ :sproglet | sprog allocations at: sproglet put: (leeways at: (index := 1 + index))]]].
    self vRigid: true.
    width := 0.
    height := children inject: 0 into: [ :h :x | h max: (x computeExtent; preferredHeight)].
    children do: [ :child || box |
        width := width + (box := child computeExtent) x.
        self vRigid: (self vRigid and: [child vRigid])."
        child extent: box x@height.
        child isAlignedComposite
            ifTrue: [ | index |
                index := 0.
                child children do: [ :sprog | sprog extent: (leeways at: (index := index + 1))@height]]"].
    (width = 0 or: [height = 0]) ifTrue: [self uimsError].
    ^self preferredExtent: width@height! !

!DynamicRowInteractor methodsFor: 'testing'!

dimension
    ^#horizontal!

isDynamicComposite
    ^true! !

StemInteractor subclass: #FillerInteractor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!


!FillerInteractor methodsFor: 'hierarchy'!

installHierarchy

    "I don't have any children - so why should I care about parents?"

    "This message would not be necessary if children were installed
    correctly by their parents, rather than by an external agent."! !

!FillerInteractor methodsFor: 'geometry'!

computeBounds: bBox
    ^self bounds: bBox!

computeExtent
    "Fillers have a natural size of zero"
    ^self preferredExtent: self minimumExtent! !

!FillerInteractor methodsFor: 'rendering'!

obsoleteRenderOn: aGC
    "aGC
        paint: self backgroundColor;
        displayRectangle: self bounds"! !

!FillerInteractor methodsFor: 'printing'!

printHierarchyOn: aStream indent: i

    aStream crtab: i; nextPutAll: self class name , self auxiliaryPrintInfo! !

View subclass: #InteractorView
    instanceVariableNames: 'rootInteractor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Interactors-Framework'!
InteractorView comment:
'PixmapView is a scrollable view onto a Pixmap.

The view updates upon receipt of an update message; this usually has to be initiated by sending changed to the underlying Pixmap.'!


!InteractorView methodsFor: 'initialize-release'!

release

    rootInteractor release.
    rootInteractor := nil.
    super release! !

!InteractorView methodsFor: 'displaying'!

displayOn: aGC
    model displayOn: aGC! !

!InteractorView methodsFor: 'accessing'!

displayObject
    ^model!

interactor: root
    rootInteractor := root! !

!InteractorView methodsFor: 'controller accessing'!

defaultControllerClass
    ^InteractorController!

setController: aController

    super setController: aController! !

!InteractorView methodsFor: 'resizing'!

bounds: bBox
    model bounds = bBox
        ifFalse: [rootInteractor recomposeIn: bBox]! !

!InteractorView methodsFor: 'event processing'!

keyboardDown: aPoint

    ^rootInteractor keyboardDown: aPoint!

operateDown: aPoint

    ^rootInteractor operateDown: aPoint!

selectDown: aPoint

    ^rootInteractor selectDown: aPoint!

startUp: aPoint

    ^rootInteractor startUp: aPoint! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

InteractorView class
    instanceVariableNames: ''!


!InteractorView class methodsFor: 'instance creation'!

model: aPixmap interactor: root
    "Answer an instance of the receiver whose model is aPixmap."

    | aView |
    aView := (self new) model: aPixmap; interactor: root.
    ^aView! !
VirtualInteractor initialize!

SliderInteractor initialize!

InsetInteractor initialize!

ActiveInteractor initialize!

BorderInteractor initialize!

GraphInteractor initialize!

CompositeInteractor initialize!